Code To Open Files Within Folder Make Changes And Close

Sub OpenAndClearContentsInColumnAG()


Dim strF As String, strP As String
Dim wb As Workbook
Dim ws As Worksheet


'Edit this declaration to your folder name
strP = "C:\Documents and Settings\MANAGER\Desktop\Darrens Catalogues"


strF = Dir(strP & "\*.xlsm") 'Change as required


Do While strF <> vbNullString


    Set wb = Workbooks.Open(strP & "\" & strF)
    Set ws = wb.Sheets(1) 'uses first sheet or if all the same names then ws.Sheets("yoursheet")
    ws.Range("AG2:AG" & ws.Range("AG" & ws.Rows.Count).End(xlUp).Row).ClearContents
    wb.Close True
    
    strF = Dir()
Loop


End Sub

Option Explicit

Sub CheckSheets()

    Dim fDialog         As Office.FileDialog
    Dim varFile         As Variant
    Dim wb              As Workbook
    Dim ws              As Worksheet
    Dim lookupRange     As Range
    Dim newRange        As Range
    Dim thisCell        As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set lookupRange = ThisWorkbook.Sheets("LookUp").Range("A1:A36")     'Set as you see fit
    Set newRange = ThisWorkbook.Sheets("LookUp").Range("B1:B36")         'Set as you see fit
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    
    With fDialog
        .AllowMultiSelect = True
        .Title = "Import Files"
        .Filters.Clear
        .Filters.Add "Excel Documents", "*.xlsx"
        .Filters.Add "Excel Macro Documents", "*.xlsm"
        .Filters.Add "All Files", "*.*"
    End With
    
    If fDialog.Show Then
    'Check for cancel
        
        For Each varFile In fDialog.SelectedItems
    
            Set wb = Workbooks.Open(varFile)
            Set ws = wb.Sheets(1) 'uses first sheet or if all the same names then ws.Sheets("yoursheet")
            
            For Each thisCell In ws.Range("AG2:AG" & ws.Range("AG" & ws.Rows.Count).End(xlUp).Row)
            
                On Error Resume Next
                If Not IsError(Application.WorksheetFunction.Match(thisCell.Value, lookupRange, 0)) Then
                
                    thisCell.Value = Application.WorksheetFunction.Index(newRange, Application.WorksheetFunction.Match(thisCell.Value, lookupRange, 0))
                
                End If
                On Error GoTo 0
            
            Next thisCell
            
            Application.Calculate
            wb.Close True
        
        Next varFile
    
    End If

    Application.Calculation = xlCalculationSemiautomatic
    Application.ScreenUpdating = True

End Sub

Sub CheckSheets()


    Dim fDialog         As Office.FileDialog
    Dim varFile         As Variant
    Dim wb              As Workbook
    Dim ws              As Worksheet
    Dim lookupRange     As Range
    Dim newRange        As Range
    Dim thisCell        As Range
    Dim r               As Long
    Dim lstCol          As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set lookupRange = ThisWorkbook.Sheets("LookUp").Range("A1:A36")     '*****Set as you see fit
    Set newRange = ThisWorkbook.Sheets("LookUp").Range("B1:B36")         '*****Set as you see fit
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    
    With fDialog
        .AllowMultiSelect = True
        .Title = "Import Files"
        .Filters.Clear
        .Filters.Add "Excel Documents", "*.xlsx"
        .Filters.Add "Excel Macro Documents", "*.xlsm"
        .Filters.Add "All Files", "*.*"
    End With
    
    If fDialog.Show Then
    'Check for cancel
        
        For Each varFile In fDialog.SelectedItems
        
            lstCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1
    
    
            Set wb = Workbooks.Open(varFile)
            Set ws = wb.Sheets(1) '*****  uses first sheet or if all the same names then ws.Sheets("yoursheet")
            Cells(1, lstCol) = wb.Name
            For Each thisCell In ws.Range("AG2:AG" & ws.Range("C" & ws.Rows.Count).End(xlUp).Row)   '*****Set as you see fit  Column C
            r = 0
                On Error Resume Next
                r = Application.WorksheetFunction.Match(thisCell.Value, lookupRange, 0)
                On Error GoTo 0
                If r > 0 Then
                     thisCell.Value = Application.WorksheetFunction.Index(newRange, r)
                     '**** Mark the lookup range as having been found in AG
                     If Application.WorksheetFunction.Index(lookupRange.Offset(0, lstCol - 1), r, 1) = "" Then _
                        Application.WorksheetFunction.Index(lookupRange.Offset(0, lstCol - 1), r, 1) = "***"
                End If
        
            Next thisCell
            
            Application.Calculate
            wb.Close True
        
        Next varFile
    
    End If


    Application.Calculation = xlCalculationSemiautomatic
    Application.ScreenUpdating = True


End Sub