Need a Find/Match Macro Desperately

[copleyr]

Hello all:

I am in desperate need of efficiency with constantly updating files (1000's each week)

1) I need a macro that can look in column "A" of my "Index" worksheet.

2) I then need it to match the first 7 characters of each entry in column "A" with the file names in the folder "C:\Users\copleyr\Desktop\All/". All of the files in this folder are excel files, each with the same naming convention.

3) once it matches, I need it to copy the row of the matching 7 characters in the "Index" worksheet, columns "A" through "BM", and paste it in the "Defaults" tab, row "70" of the matching file in "C:\Users\copleyr\Desktop\All/" .


I have some pieces of macro that helps (below), from prior macros. I just need somebody to help me consolidate everything:

SummarySheet = ActiveWorkbook.Name
MyPathName = "C:\Users\copleyr\Desktop\All/" MyFileName = Dir(MyPathName)
X = 0
Do While MyFileName <> ""
    X = X + 1
    Workbooks.Open (MyPathName & MyFileName)
    Application.DisplayAlerts = False
    Sheets("Defaults").Range("A70:BM70").Copy
    Workbooks(SummarySheet).Activate
    Range("A" & X & ":BM" & X).PasteSpecial xlPasteValuesAndNumberFormats
    Range("A" & X & ":BM" & X).PasteSpecial xlPasteFormats
    Workbooks(MyFileName).Close False
    MyFileName = Dir
Application.DisplayAlerts = True
Loop
End Sub

Sub ListFiles()
Dim MyPathName As String
Dim MyFileName As String
Dim NumChars As Long
Dim X As Long

    NumChars = 7 'Change this to the number of characters you want to return
    MyPathName = "C:\Users\copleyr\Desktop\All/" 'Change this to the folder you want to return
    MyFileName = Dir(MyPathName)
    Do While MyFileName <> ""
        X = X + 1
        Sheet1.Cells(X, 1) = Left(MyFileName, NumChars)
        MyFileName = Dir
    Loop
End Sub

Can anybody point me in the right direction of getting started? Thank you so much for your help in advance!

 

[wigi]

Hello Ryan

Try:

Sub UpdateFiles()

    'Change all this if needed
    Const NumChars As Long = 7
    Const MyPathName As String = "C:\Users\copleyr\Desktop\All\"
    
    
    Dim MyFileName As String
    Dim wb As Workbook
    Dim lRow As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    With ThisWorkbook.Worksheets("Index")
    
        For lRow = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
        
            Application.StatusBar = "Processing row " & lRow & "..."
            
            MyFileName = MyPathName & Left(.Range("A" & lRow).Text, 7)
        
            If Len(Dir(MyFileName)) > 0 Then
            
                Set wb = Workbooks.Open(MyFileName, 0)
                
                .Range("A" & lRow, "BM" & lRow).Copy Destination:=wb.Worksheets("Defaults").Range("A70")
                
                wb.Close savechanges:=True
                
                Set wb = Nothing
                
            End If
            
        Next lRow
        
    End With
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = False
    
    MsgBox "Ready.", vbInformation, "Status"
    
End Sub

Untested code, though.

Wigi

 

[wigi]

1 small change in the code:

Sub UpdateFiles()

    'Change all this if needed
    Const NumChars As Long = 7
    Const MyPathName As String = "C:\Users\copleyr\Desktop\All\"
    
    
    Dim MyFileName As String
    Dim wb As Workbook
    Dim lRow As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    With ThisWorkbook.Worksheets("Index")
    
        For lRow = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
        
            Application.StatusBar = "Processing row " & lRow & "..."
            
            MyFileName = MyPathName & Left(.Range("A" & lRow).Text, NumChars)
        
            If Len(Dir(MyFileName)) > 0 Then
            
                Set wb = Workbooks.Open(MyFileName, 0)
                
                .Range("A" & lRow, "BM" & lRow).Copy Destination:=wb.Worksheets("Defaults").Range("A70")
                
                wb.Close savechanges:=True
                
                Set wb = Nothing
                
            End If
            
        Next lRow
        
    End With
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = False
    
    MsgBox "Ready.", vbInformation, "Status"
    
End Sub

 

[copleyr]

Hey Wigi,

Thanks for your response. When I run the macro, I instantly get the text box "Ready". I do not think anything happens.

Is the macro looking at the first 7 characters in the title of each excel file? (In C:\Users\copleyr\Desktop\all) ?

Thanks again!

 

[wigi]

Hey Wigi,

Thanks for your response. When I run the macro, I instantly get the text box "Ready". I do not think anything happens.

Is the macro looking at the first 7 characters in the title of each excel file? (In C:\Users\copleyr\Desktop\all) ?

Thanks again!

Hello

What happens is that in a loop, we will go through every cell of column A on sheet "Index" of the file containing the code.

The first 7 characters are taken. If a file is found within the specified folder, it will be opened. Now that I reread it, I think I forgot the extension of the file.

Try:

MyFileName = MyPathName & Left(.Range("A" & lRow).Text, NumChars) & ".xls"

for instance (or change this if you need .xlsx or .xlsm)

If such a file is found, it is opened and we copy the contents of columns A to BM to the opened file. That file is then saved and closed again.

Can you step through the macro using F8? Only the file with the code should be opened, VBA code will open the files if it finds a match.

 

[copleyr]

Hey Wigi,

I am using the below code. I tried all three of the different extensions and I am still getting the instantaneous message box.

In the "index" tab, column A, it contains the first 7 characters that identify the files in (C:\Users\copleyr\Desktop\all)

The files in (C:\Users\copleyr\Desktop\all) will contain these first 7 characters for identification, but the file name will have more characters after that.

Could this be an issue?

Sub UpdateFiles()
    Const NumChars As Long = 7
    Const MyPathName As String = "C:\Users\copleyr\Desktop\All\"
    
    
    Dim MyFileName As String
    Dim wb As Workbook
    Dim lRow As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    With ThisWorkbook.Worksheets("Sheet1")
    
        For lRow = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
        
            Application.StatusBar = "Processing row " & lRow & "..."
            
            MyFileName = MyPathName & Left(.Range("A" & lRow).Text, NumChars) & ".xlsx"
        
            If Len(Dir(MyFileName)) > 0 Then
            
                Set wb = Workbooks.Open(MyFileName, 0)
                
                .Range("A" & lRow, "BN" & lRow).Copy Destination:=wb.Worksheets("Defaults").Range("A70")
                
                wb.Close savechanges:=True
                
                Set wb = Nothing
                
            End If
            
        Next lRow
        
    End With
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = False
    
    MsgBox "Ready.", vbInformation, "Status"
    
End Sub

 

[wigi]

Yes, that will be the issue. I though that column A had more characters, of which we take the first 7, but that from then on the file in the folder has no extra characters.

 

[wigi]

Could it be that there are multiple files that match the 7 characters?

 

[copleyr]

No, there will only be one file that matches the 7 characters in column "A" in the "index" tab.

 

[copleyr]

an example of the first seven characters would be "11-0130" in column "A" of the "index" tab.

an example of the matching file name would be "11-0130 blue sky example"