LSullivanFinal

“Form ever follows function” is a phrase coined by Louis Sullivan, pictured here, though largely quoted as “Form follows function”.

Topic Index


Application

Columns

Sheets

Worksheets

Miscellaneous


Application

    FileDialog

Public Function GetFDObjectName(strDialogType As String) As String
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'GetFDObjectName
    'Returns either the name of a folder or the name of a file based on the type passed into the function, "strDialogType"
    'Return is a value of data type string
    '
    'Parameters        :
    'strDialogType     :   Required, A string. If "Folder" then the FileDilaog will be msoFileDialogFolderPicker,
    '                      otherwise msoFileDialogFilePicker
    '
    'Uses these global constants
    '  Public Const gclmsoFileDialogFilePicker = 3                 'File Picker
    '  Public Const gclmsoFileDialogFolderPicker = 4               'Folder Picker
    '  Public Const gclmsoFileDialogOpen = 1                       'Open
    '  Public Const gclmsoFileDialogSaveAs = 2                     'SaveAs
    '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
    'Declare variables
        Dim fd As FileDialog
        Dim strObjectName As String
        Dim strTitle As String
         
    'Choose if user requested a folder dialog or other
        Select Case strDialogType
            Case "Folder"                                                               'Folder Dialog
                strTitle = "Please select a folder"
                Set fd = Application.FileDialog(gclmsoFileDialogFolderPicker)
            Case Else
                strTitle = "Please select a file"                                       'File Dialog
                Set fd = Application.FileDialog(gclmsoFileDialogFilePicker)
        End Select
         
    'Invoke filedialog
        With fd
            .Title = strTitle
            .AllowMultiSelect = False
            .Show
            strObjectName = .SelectedItems(1)
        End With
         
    'Pass value to function
        GetFDObjectName = strObjectName
     
    'Tidy up
        Set fd = Nothing
         
End Function

    GoTo Cell

Public Function GoToCell(wb As Workbook, _
                         Optional ByVal lngRow As Long = 1, _
                         Optional ByVal lngColumn As Long = 1) As String
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'GoToCell
    'Scroll to cell(lngRow,lngColumn) on each worksheet in thew workbook
    
    'Parameters :
    'Workbook   :   Required, a workbook object
    'lngRow     :   Optional, Row to scroll to, Default = Row 1
    'lngColumn  :   Optional, Column to scroll to, Default = Column 1
    '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'Declare variables
        Dim ws As Worksheet
        Dim strAddress As String
    
    'Scroll to cell(lngRow,lngColumn) on each worksheet in the workbook
        With wb
            For Each ws In .Worksheets
                Application.Goto Reference:=ws.Cells(lngRow, lngColumn), _
                                 Scroll:=True
            Next ws
        End With
        
    'Get address of activecell
        strAddress = ActiveCell.Address
        
    'Pass value to function
        ScrollToCell = strAddress
    
End Function

    Get User Input

Public Function GetUserInput(strPrompt As String, _
                             strTitle As String) As Variant

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'GetUserInput
    'Provide an InputBox to get input from user at run-time
    'Return is of data type variant
    '
    'Parameters :
    'strPrompt  :   Required, Provide some text to user explain what you would like them to enter
    'strTitle   :   Required, The title to be used for the InputBox
    '
    'Resources  :   http://msdn.microsoft.com/en-us/library/office/ff839468(v=office.15).aspx
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    'Declare variables
        Dim UserInput As Variant
        
    'Get user input
        UserInput = InputBox(strPrompt, _
                             strTitle)
                             
    'Pass value to function
        GetUserInput = UserInput
                    
End Function

    Get Worksheet Name From User Selected Cell

Public Function GetSelectedSheet(strPrompt As String, _
                                 strTitle As String) As String

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'GetSelectedSheet
    'Returns the worksheet name that is parent of user selected cell
    'Return is a value of data type long
    '
    'Parameters        :
    'strPrompt         :   Required, Provide a message to the user to select a cell on a worksheet
    'strTitle          :   Required, Provide a title for the InputBox
    '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      
    'Declare variables
        Dim ws                          As Worksheet
        Dim rng                         As Range
      
    'Users - select a cell on a worksheet
        Set rng = Application.InputBox( _
                                       Prompt:=strPrompt, _
                                       Title:=strTitle, _
                                       Default:=ActiveCell.Address, _
                                       Type:=8) 'Range selection
                      
    'Get the parent worksheet of the selected cell
        Set ws = rng.Parent
          
    'Pass the name of the worksheet to the function
        GetSelectedSheet = ws.Name
      
    'Tidy up
        Set rng = Nothing
        Set ws = Nothing
 End Function

Columns

    Get Last Used Column

Public Function GetLastUsedColumn(ws As Worksheet, _
                                  Optional ByVal lngRow As Long = 1) As Long
                           
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'GetLastUsedColumn
    'Returns the last used column number in the referenced row
    'Return is a value of data type long
    '
    'Parameters :
    'ws         :   Required, A worksheet object
    'lngrow     :   Optional, Row to find last used column on, Default = Row 1
    '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'Declare variables
        Dim c As Long
        
    'Get the last used column number in the referenced row
        c = ws.Cells(lngRow, Columns.Count).End(xlToLeft).Column
        
    'Pass value to function
        GetLastUsedColumn = c

End Function

    Find Column Number

Public Function FindColumnNumber(ws As Worksheet, _
                                 strSearchTerm As String) As Long
                                 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'FindColumnNumber
    'Returns the column number based on the location of the search term
    'Return is a value of data type long
    '
    'Parameters        :
    'ws                :   Required, A worksheet object
    'strSearchTerm     :   Required, a value to search for in the specified range
    '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'Declare variables
        Dim rng             As Range
        Dim MaxColumns      As Long
        Dim lngField        As Long
        
    'Initialize
        MaxColumns = GetLastUsedColumn(ws:=ws)
        With ws
            Set rng = .Range(.Cells(1, 1), .Cells(1, MaxColumns))
        End With
        
    'Find columns number
        lngField = rng.Find(What:=strSearchTerm, _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            MatchCase:=False).Column
                            
    'Pass value to function
        FindColumnNumber = lngField
        
    'Tidy up
        Set rng = Nothing

End Function

Sheets

    Delete Sheets

Public Function DeleteSheets(wb As Workbook) As Long
 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'DeleteSheets
    'Deletes all sheets in the referenced workbook except for the first sheet
    'Return is of data type long
    '
    'Parameters :
    'wb         :   Required, The workbook from which sheets should be deleted
    '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
    'Declare variables
        Dim i As Long
        Dim x As Long
         
    'Turn off warnings
        With Application
            .DisplayAlerts = False
        End With
         
    'Delete all sheets except first sheet
        With wb
            For i = .Sheets.Count To 2 Step -1
                .Sheets(i).Delete
            Next i
            x = .Sheets.Count
        End With
         
    'Pass value to function
        DeleteSheets = x
         
    'Tidy up
        With Application
            .DisplayAlerts = True
        End With
         
End Function

Worksheets

    Add A Worksheet

Public Function AddWorksheet(wb As Workbook) As Worksheet

 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'AddWorksheet
    'Adds a worksheet after the last sheet in the reference workbook
    'Return is a worksheet object
    '
    'Parameters :
    'wb         :   Required, The workbook to which a worksheet should be added
    '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'Declare variables
        Dim wsNew As Worksheet
        
    'Add worksheet to end of other worksheets in the workbook
        With wb
            Set wsNew = .Worksheets.Add _
                                    (After:=.Worksheets(.Worksheets.Count))
                            
        End With
        
    'Return object to function
        Set AddWorksheet = wsNew
        
    'Tidy up
        Set wsNew = Nothing
        
End Function

Miscellaneous

    Get Position Of Last Character In A String

Public Function GetLastCharInstance(strChar As String, _
                                    rng As Range) As Long
                                    
    '-------------------------------------------------------------------------------------------------------------
    'Author:        ws
    'Date:          5/20/2015
    'Purpose:       Get position of last occurrence of character in string
    'Comments:      Uses VBA Function: InStrRev()
    '
    'Parameters:    strChar -  Required. A string variable. The substring to be searched for.
    '               rng     -  Required. A range object representing a cell that contains a string to be searched.
    '-------------------------------------------------------------------------------------------------------------
                                    
    'Declare variables
        Dim lngPosition As Long
        Dim strSearch As String
        
    'Error handler
        On Error GoTo ErrHandler
 
    'Get string to be searched
        strSearch = rng.Value
        
    'Get last position
        lngPosition = InStrRev(strSearch, strChar)
        
    'Pass value to function
        GetLastCharInstance = lngPosition
        
ErrHandler:
    If Err.Number > 0 Then _
        MsgBox Err.Description, vbMsgBoxHelpButton, "Get character position", Err.HelpFile, Err.HelpContext
 
End Function