Function LastRowInColumn(intCol As Integer) As Integer

    On Error GoTo LRICError
    
    Application.Volatile 'This will make sure that this function is called if anything is changed on the Worksheet

    LastRowInColumn = Cells(Rows.Count, intCol).End(xlUp).Row

ExitFnxn:    
    Exit Function
    
    'If there's an error in this function, then return an error to Excel

LRICError:
    LastRowInColumn = CVErr(xlErrNA)
    Resume ExitFnxn

End Function

Dim X as Integer

X = LastRowInColumn(2)

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$B$1" Then
        FilterList
    End If
    
End Sub

Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
'This function will bring up a form to let the user select a directory
Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim r As Long, X As Long, i As Integer

'   Root folder = Desktop
    bInfo.pidlRoot = 0&

'   Title in the dialog
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = Msg
    End If
    
'   Type of directory to return
    bInfo.ulFlags = &H1

'   Display the dialog
    X = SHBrowseForFolder(bInfo)
    
'   Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal X, ByVal path)
    If r Then
          i = InStr(path, Chr$(0))
        GetDirectory = Left(path, i - 1)
    Else
        GetDirectory = ""
    End If
End Function

FileName = Application.GetOpenFilename()

'Return the name of the Sheet from which the function was called
Public Function GetSheetName() As String

    GetSheetName = Application.Caller.Parent.Name
    
End Function

Sub FindErrors()

    'If no errors are found, it would cause an error on the Select statement
    On Error GoTo FEError
    
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas, xlErrors).Select
    
    Exit Sub
    
FEError:
    MsgBox "No Errors Found", , "Clear!"
    Exit Sub
    
End Sub

Function GetLastRow(SheetID) As Long

    Dim LastRow As Long
    
    If Application.WorksheetFunction.CountA(Worksheets(SheetID).Cells) = 0 Then
        LastRow = 1
    Else
        LastRow = Worksheets(SheetID).UsedRange.Rows.Count + Worksheets(SheetID).UsedRange.Row
            
        While Application.WorksheetFunction.CountA(Worksheets(SheetID).Rows(LastRow)) = 0
            LastRow = LastRow - 1
        Wend
    End If
    
    GetLastRow = LastRow
    
End Function

'Position the worksheet so that cell M14 is in the upper left corner
    Worksheets(1).Select
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollColumn = 13

Application.GoTo Range("G10"), True

Sub AddToolBar()

    Dim cmdbar As CommandBar
    Dim CmdBtn1 As CommandBarButton
    Dim strTBName As String

    strTBName = "MyToolbar"
    
    'If the toolbar is already there, then don't try to add it again
    If CheckForToolbar(strTBName) Then Exit Sub
    
    Set cmdbar = CommandBars.Add(Name:=strTBName, Position:=msoBarTop, Temporary:=True)
    cmdbar.Visible = True
    
    With cmdbar
        'We'll put the toolbar at the right edge of the "Standard" toolbar

        .Left = CommandBars("Standard").Width
        .RowIndex = CommandBars("Standard").RowIndex
        
        Set CmdBtn1 = .Controls.Add(msoControlButton, , , , True)
        With CmdBtn1
            .Style = msoButtonCaption
            .Caption = "MyToolbar"
            .TooltipText = "This is my sample toolbar"
            .OnAction = "HelloWorld"
        End With
        
    End With
    
    Set cmdbar = Nothing
    Set CmdBtn1 = Nothing
    
End Sub


Function CheckForToolbar(argName As String) As Boolean

    Dim bar As CommandBar, Result As Boolean
    
    Result = False
    
    For Each bar In CommandBars
        If bar.Name = argName Then
            Result = True
        End If
    Next bar
    
    CheckForToolbar = Result
    
End Function

Sub HelloWorld()

    Msgbox "Hello World!"

End Sub

Option Explicit

Sub AddMenuItems()

    'Our menu item as it will appear on the menu bar
    Dim mnuNew As CommandBarControl
    'Some properties of our new menu
    Dim strMenuName As String, strMenuCaption As String
    'Some dummy sub-menu items
    Dim mnuTest1 As CommandBarControl, mnuTest2 As CommandBarControl, mnuTest3 As CommandBarControl
    'The position where we want to put our new menu item
    Dim intPosition As Integer
        
    strMenuName = "MyMenu"
    strMenuCaption = "&My Menu"

    'Don't add the things twice
    If CheckForMenu(strMenuCaption) Then Exit Sub
    
    With CommandBars("Worksheet Menu Bar")
        'Let's put our new menu to the immediate left of the "Window" menu
        For Each mnuNew In .Controls
            If mnuNew.Caption = "&Window" Then intPosition = mnuNew.Index
        Next mnuNew

        'See VBA help file for CommandBarControls' Add method for more info
        Set mnuNew = .Controls.Add(msoControlPopup, , , intPosition, True)
        
        With mnuNew
            .Caption = strMenuCaption
            .Visible = True
            
            Set mnuTest1 = .Controls.Add(msoControlButton, , , , True)

            With mnuTest1
                .Caption = "Test&1"
                .OnAction = "MySub1"
            End With
            
            Set mnuTest2 = .Controls.Add(msoControlPopup, , , , True)
            
            'mnuTest2 will actually be a parent menu with mnuTest3 as its own sub-menu
            With mnuTest2
                .Caption = "Test&2"
                .BeginGroup = True
                
                Set mnuTest3 = .Controls.Add(msoControlButton, , , , True)
                With mnuTest3
                    .Caption = "Test&3"
                    .OnAction = "MySub2"
                End With
            End With
        End With
    End With
    
    'Kill all of the object variables
    Set mnuNew = Nothing
    Set mnuTest1 = Nothing
    Set mnuTest2 = Nothing
    Set mnuTest3 = Nothing
    
End Sub



Function CheckForMenu(argCaption) As Boolean

    Dim bar As CommandBarPopup, Result As Boolean
    
    Result = False
    
    With CommandBars("Worksheet Menu Bar")
        For Each bar In .Controls
            If bar.Caption = argCaption Then
                Result = True
            End If
        Next bar
    End With

    CheckForMenu = Result
    
End Function


Sub MySub1()

    MsgBox "MySub1"
    
End Sub


Sub MySub2()

    MsgBox "MySub2"
    
End Sub

'creates a new worksheet in the workbook specified, populating it with an array of formula's which compare
' the contents of the worksheets specified.
' Matched blank cells show no result. Other matches return TRUE OR FALSE
'Arguments::
'strWorkbookName$ : Name of workbook containing worksheets to compare
'strSheetName1$ : Name of first sheet to compare
'strSheetName2$ : Name of second sheet to compare

Sub WorksheetValuesCompare(strWorkbookName$, strSheetName1$, strSheetName2$)
Dim shtNew As Worksheet
Dim rngFormula As Range
Dim strFormula$
Dim lngRow1&, lngRow2&, lngCol1&, lngCol2&
Dim lngRow&, lngCol&

Const FORMULA_STRING$ = "=IF(AND(ISBLANK(INDIRECT(ADDRESS(ROW(),COLUMN(),1,,""One"")))," & _
            "ISBLANK(INDIRECT(ADDRESS(ROW(),COLUMN(),1,,""Two"")))),""""," & _
            "AND(NOT(ISNA(MATCH(INDIRECT(ADDRESS(ROW(),COLUMN(),1,,""One""))," & _
            "INDIRECT(ADDRESS(ROW(),COLUMN(),1,,""Two"")),0)))))"
            
    With Workbooks(strWorkbookName$)
        'return row/column counts
        lngRow1& = UBound(.Sheets(strSheetName1$).UsedRange.Value)
        lngRow2& = UBound(.Sheets(strSheetName2$).UsedRange.Value)
        lngCol1& = UBound(.Sheets(strSheetName1$).UsedRange.Value, 2)
        lngCol2& = UBound(.Sheets(strSheetName2$).UsedRange.Value, 2)
        
        'retain highest counts
        If lngRow1& > lngRow2& Then lngRow2& = lngRow1&
        If lngCol1& > lngCol2& Then lngCol2& = lngCol1&
                         
        'return row/column counts
        lngRow1& = LBound(.Sheets(strSheetName1$).UsedRange.Value)
        lngRow& = LBound(.Sheets(strSheetName2$).UsedRange.Value)
        lngCol1& = LBound(.Sheets(strSheetName1$).UsedRange.Value, 2)
        lngCol& = LBound(.Sheets(strSheetName2$).UsedRange.Value, 2)
        
        'retain lowest counts
        If lngRow1& > lngRow& Then lngRow1& = lngRow&
        If lngCol1& > lngCol& Then lngCol1& = lngCol&
        
        Set shtNew = .Sheets.Add(.Sheets(1))
        
    End With
                         
    'substitute required worksheet names
    strFormula$ = Replace(FORMULA_STRING$, """One""", """" & strSheetName1$ & """")
    strFormula$ = Replace(strFormula$, """Two""", """" & strSheetName2$ & """")
                 
    'populate new analysis worksheet with formula
    With shtNew
        .Range(.Cells(lngRow1&, lngCol1&), .Cells(lngRow2&, lngCol2&)).Formula = strFormula$
        .Calculate
    End With
    
Finish:
On Error Resume Next
    Set rngFormula = Nothing
    Set shtNew = Nothing
    Exit Sub
    
End Sub

'function arguments are: a variant array of values to find 'aryFind', and
'   a range object to search in 'rngSearch'
'returns an array of type Long containing the count of each array item found in the range

Function Get_ValueCount(aryFind As Variant, rngSearch As Range)
Dim FindThis
Dim rngFound As Range
Dim aryFound()
Dim lngCountFind&, lngCountFound&
Dim strFirstAddress$

    'loop each element of the array for values to find
    For Each FindThis In aryFind
    
        'resize the array to hold the count of the values found
        ReDim Preserve aryFound(lngCountFind&)
        With rngSearch
            
            'position the search at the start of the range
            Set rngFound = rngSearch.Cells(1, 1)
            'reset variables
            lngCountFound& = 0
            strFirstAddress$ = ""
            
            Do
            
                'use the Find method to locate the value in the range
                Set rngFound = .Find(What:=FindThis, After:=rngFound)
                If Not rngFound Is Nothing Then
                    'the value was found, halt the process if the method has "wrapped"
                    '   to the start of the range
                    If rngFound.Address = strFirstAddress$ Then Exit Do
                    
                    'retain the address of the first value found
                    If strFirstAddress$ = "" Then strFirstAddress$ = rngFound.Address
                    'increment counter for found values
                    lngCountFound& = lngCountFound& + 1
                End If
            
            'Find method returns Nothing if there was no matching value
            Loop While Not rngFound Is Nothing
            aryFound(lngCountFind&) = lngCountFound&
            
        End With
        lngCountFind& = lngCountFind& + 1
        
    Next FindThis

    'assign the array to the function return value
    Get_ValueCount = aryFound
    
Finish:
    Erase aryFound
    
End Function

Workbooks(x).Close Savechanges:=True

Application.DisplayAlerts = False
Workbooks(x).Close
Application.DisplayAlerts = True

Workbooks(x).Saved = True
Workbooks(x).Close