Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean On Error Resume Next WorksheetExists = (Sheets(WorksheetName).Name <> "") On Error GoTo 0 End Function
Friday, December 27, 2013
VBA - Determine if worksheet of a given name exists
The following function takes a worksheet name as input and returns True/False whether or not a worksheet of that name exists:
VBA - Removing Illegal characters for a sheet name
I'll often want a MACRO to name a worksheet based on user input. Users often enter characters that aren't allowed to be contained within a worksheet name though. The following lines strip all illegal characters out of a variable so it can be used as a worksheet name:
MyArray = Array("<", ">", "|", "/", "*", "\", "?", "[", "]", """") For X = LBound(MyArray) To UBound(MyArray) SheetName = Replace(SheetName, MyArray(X), "_", 1) Next X
VBA - Misc useful Excel MACROs
These are a collection of tools I use to help me with redundant tasks:
Sub ToolAppendWorksheets() 'Define some vars Dim wb As Workbook, wb2 As Workbook Dim WS As Worksheet Dim vFile As Variant 'Set source workbook/worksheet Set wb = ActiveWorkbook Set WS = ActiveSheet 'Open the target workbook vFile = Application.GetOpenFilename("Excel-files,*", _ 1, "Select a file to append worksheets from", , False) 'if the user didn't select a file, exit sub If TypeName(vFile) = "Boolean" Then Exit Sub Workbooks.Open vFile 'Set targetworkbook Set wb2 = ActiveWorkbook For Each sh In wb2.Worksheets sh.Copy After:=wb.Sheets(wb.Sheets.Count) Next sh wb2.Close SaveChanges:=False End Sub Sub ToolRemoveDuplicates() 'A macro to delete all rows that have a duplicate entry in a certain column 'Easy user defined vars DupCol = Int(InputBox("Which column are we comparing for duplicate entries?")) CompareChars = 50 StartingRow = Int(InputBox("Starting at which row?")) 'Internal code lastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row For rwIndex = StartingRow To lastrow CurLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row For delIndex = CurLastRow To rwIndex + 1 Step -1 If Left(Cells(rwIndex, DupCol), CompareChars) = Left(Cells(delIndex, DupCol), CompareChars) Then Rows(delIndex).Delete End If Next delIndex Next rwIndex End Sub Sub ToolInsertXRows() RowsToInsert = InputBox("How many rows would you like to insert?") InsertPoint = InputBox("Which row would you like to insert them at?") For Point = 1 To RowsToInsert Cells(InsertPoint, 1).Offset(1).EntireRow.Insert Next Point End Sub Sub ToolJoinAndMerge() Dim outputText As String delim = " " On Error Resume Next For Each cell In Selection outputText = outputText & cell.value & delim Next cell 'Removes the Trailing Delim If Right$(outputText, 1) = delim Then outputText = Left$(outputText, Len(outputText) - 1) With Selection .Clear .Cells(1).value = outputText .Merge .HorizontalAlignment = xlGeneral .VerticalAlignment = xlCenter .WrapText = True End With Selection.ClearFormats End Sub Sub ToolDeleteBlankRows() 'Deletes the entire row within the selection if the ENTIRE row contains no data. 'We use Long in case they have over 32,767 rows selected. Dim i As Long 'We turn off calculation and screenupdating to speed up the macro. With Application .Calculation = xlCalculationManual .ScreenUpdating = False 'We work backwards because we are deleting rows. For i = Selection.Rows.Count To 1 Step -1 If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then Selection.Rows(i).EntireRow.Delete End If Next i .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub
VBA - Returning the column letter for a given header in the first row
Using a wrapper for the find function - I prefer to use a wrapper to simplify my syntax elsewhere in the program - we will be able to return the numerical value for the column that has the header text we are looking for. We then use a function to convert this numerical value to the desired letter range:
Public Function FindHeader(HeaderText As String, Optional ourRow As Integer = 1) FindHeader = Rows(ourRow).Find(What:=HeaderText, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, _ SearchFormat:=False).Column End Function Public Function ColumnLetter(ColumnNumber As Integer) As String Dim n As Integer Dim c As Byte Dim s As String n = ColumnNumber Do c = ((n - 1) Mod 26) s = Chr(c + 65) & s n = (n - c) \ 26 Loop While n > 0 ColumnLetter = s End Function Sub testing() MsgBox (ColumnLetter(FindHeader("Search Text"))) End Sub
VBA - Finding last used row or column in Excel Worksheet
To do so we use the following lines, where mysheet is the worksheet you want to find these values for:
Dim mysheet as WorkSheet Set mysheet = ActiveSheet LastRow = mysheet.Cells(mysheet.Rows.Count, "A").End(xlUp).Row LastCol = mysheet.Cells(1, mysheet.Columns.Count).End(xlToLeft).Column
Subscribe to:
Posts (Atom)