Loading...
 
JoiWiki » Developer » MS Office » VBA Snippets » VBA Common Methods VBA Common Methods

VBA Common Methods

 

Alright, I know - they're not actually 'methods' in VBA, they're referred to as subs or functions, but you know what I mean. Here is a selection of methods which I've found useful to throw into a new module on an excel spreadsheet from time to time to enable a few things that I like to do quickly, the only difference between the code on this page and the others under VBA Snippets are that these are all pretty quick and simple and can be grabbed en masse. Here we go:

 

' shows the output string and header in a form
Public Sub OutputText(Header As String, Output As String)
    Dim TOut As TxtOutForm
    Set TOut = New TxtOutForm
    TOut.DisplayVal = Output
    TOut.Header = Header
    TOut.Show
    
End Sub


' reads from or writes to the clipboard
Function Clipboard(Optional StoreText As String) As String
    'PURPOSE: Read/Write to Clipboard
    'Source: ExcelHero.com (Daniel Ferry)
    
    Dim x As Variant
    
    'Store as variant for 64-bit VBA support
      x = StoreText
    
    'Create HTMLFile Object
      With CreateObject("htmlfile")
        With .parentWindow.clipboardData
          Select Case True
            Case Len(StoreText)
              'Write to the clipboard
                .setData "text", x
            Case Else
              'Read from the clipboard (no variable passed through)
                Clipboard = .GetData("text")
          End Select
        End With
      End With

End Function



' counts down from the passed cell address and gives the number of continuous values
Public Function GetSeriesCount(sheetname As String, Cell As String) As Integer
    Dim Sheet As Worksheet
    Set Sheet = Application.Workbooks(ThisWorkbook.Name).Worksheets(sheetname)
    
    If Sheet.Range(Cell).Value = "" Then
        GetSeriesCount = 0
        Exit Function
    End If
    
    ' let's loop through this in cell addresses
    Dim RowNo As Integer
    Dim ColNo As Integer
    RowNo = Sheet.Range(Cell).row
    ColNo = Sheet.Range(Cell).Column
    
    Dim count As Integer
    count = GetSeriesCountRC(sheetname, RowNo, ColNo)

    GetSeriesCount = count
End Function

' counts down from the passed row and column and gives the number of continuous values
' the long but reliable way without using XLDown
Public Function GetSeriesCountRC(sheetname As String, row As Integer, col As Integer) As Integer
    Dim Sheet As Worksheet
    Set Sheet = Application.Workbooks(ThisWorkbook.Name).Worksheets(sheetname)
    
    If Sheet.Cells(row, col).Value = "" Then
        GetSeriesCountRC = 0
        Exit Function
    End If
    
    Dim count As Integer
    count = 0
    
    ' let's loop through this in cell addresses
    Dim RowNo As Integer
    Dim ColNo As Integer
    RowNo = row
    ColNo = col
    
    Dim CountNext As Integer
    CountNext = 1
    
    Do While CountNext = 1
        If Sheet.Cells(RowNo, ColNo).Value = "" Then
            CountNext = 0
        Else
            RowNo = RowNo + 1
            count = count + 1
        End If
    Loop

    GetSeriesCountRC = count
End Function

' uses the saveFileDialog to get the path for a file to save to, using FileFilter ensures filename extension
' if using FileExt then ensure that you include the preceeding period
' FileFilter examples: "Excel Files (*.XLS), *.XLS", "Text Files (*.txt), *.txt"
Public Function GetSaveAsPath(Optional FileFilter As String) As String
    Dim varResult As Variant
    Dim result As String

    'displays the save file dialog using specified file types if needed
    If Len(FileFilter) Then
        varResult = Application.GetSaveAsFilename(FileFilter:=FileFilter)
    Else
        varResult = Application.GetSaveAsFilename
    End If
    
    'checks to make sure the user hasn't canceled the dialog
    If varResult <> False Then
        result = varResult
    End If
    
    GetSaveAsPath = result
End Function

' Asks the user where they'd like to save a text file and creates it
Public Sub SaveTextToFile(content As String)
    Dim path As String
    path = GetSaveAsPath("Text Files (*.txt), *.txt")
    ' Don't run if we don't have a path
    If Len(path) Then SaveTextFile path, content
End Sub

' saves the presented text content into a file at the path provided, filetype must be set or you won't get one on the resulting file
' will create or overwrite to the path provided
Public Sub SaveTextFile(path As String, content As String)
' this sub makes use of the microsoft scripting runtime
' to enable go to Tools>References and add "Microsoft Scripting Runtime"

    ' just exit if we've nonsense inputs
    If path = "" Then Exit Sub
    
    Dim FSO As New FileSystemObject
    
    Dim fileExists As Boolean
    fileExists = FSO.fileExists(path)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    If fileExists Then
        Set FileToUse = FSO.OpenTextFile(path, ForWriting)
    Else
        Set FileToUse = FSO.CreateTextFile(path)
    End If
    
    FileToUse.Write content
    FileToUse.Close

End Sub























 

Created by JBaker. Last Modification: Tuesday January 24, 2023 15:03:16 GMT by JBaker.

Developer