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
