VBA code required

[Marky_B]

Good evening all,
first off thank you for any help, given. I'm after automating invoices from 2 registers.
The setup is I have 2 workbooks [Register_1] and [Register_2] with 5 sheets in each [Week_1] [Week_2] [Week_3] [Week_4] [Week_5], and 1 workbook [Master] with sheet [Invoice] macros enabled to pull data from the other 2 workbooks all saved in the same folder. What I need help with is the following

• I would like code to search [Register_1] sheet [Week_1] for a surname in cell range {A8-A95} and forename cell range {B8-B95} if match found then
  • copy cell {A1} to workbook [Master] sheet [Invoice] cell {B13}
  • copy total for week to workbook [Master] sheet [Invoice] cell {C13}
  • repeat for [Week_2] [Week_3] [Week_4] [Week_5] moving copy down a cell each time in workbook [Master] sheet [Invoice]
  • If no match then end

Hopefully this all makes sense. I wish I could share the project somehow?

Thank you once again for any help

 

[juddaaaa]

Would this work

Sub CopyToMaster(Bk As String, Surname As String, Forename As String)

    Dim sn As Range, fn As Range
    Dim sht As Worksheet
    Dim nr As Long
    
    Application.ScreenUpdating = False

    If Dir(ThisWorkbook.Path & "\" & Bk) = "" Then
        MsgBox "Sorry, " & Bk & " does not exist.", vbInformation, "No such file"
        Exit Sub
    End If
    
    With Workbooks.Open(ThisWorkbook.Path & "\" & Bk, True, True)
        For Each sht In .Sheets
            Set sn = sht.Range("A8:A95").Find(What:=Surname, LookIn:=xlValues, LookAt:=xlWhole)
            Set fn = sht.Range("B8:B95").Find(What:=Forename, LookIn:=xlValues, LookAt:=xlWhole)
            
            If Not sn Is Nothing And Not fn Is Nothing Then
                With ThisWorkbook.Sheets("Invoice")
                    nr = GetNextRow(ThisWorkbook.Sheets("Invoice"), "B")
                
                    .Range("B" & nr).Value = sht.Range("A1")
                    .Range("C" & nr).Value = sht.Range("C20") '<------CHANGE TO WHERE TOTAL FOR SHEET IS
                End With
            End If
        Next sht
    End With

    Application.ScreenUpdating = True
    
End Sub

CopyToMaster _
    Bk:="Register_1.xlsx", _
    Surname:="Smith", _
    Forename:="John"

 

[juddaaaa]

Slight adjustment. Forgot to close the workbook and include GetNextRow function

Sub CopyToMaster(Bk As String, Surname As String, Forename As String)

    Dim sn As Range, fn As Range
    Dim sht As Worksheet
    Dim nr As Long
   
    Application.ScreenUpdating = False

    If Dir(ThisWorkbook.Path & "\" & Bk) = "" Then
        MsgBox "Sorry, " & Bk & " does not exist.", vbInformation, "No such file"
        Exit Sub
    End If
   
    With Workbooks.Open(ThisWorkbook.Path & "\" & Bk, True, True)
        For Each sht In .Sheets
            Set sn = sht.Range("A8:A95").Find(What:=Surname, LookIn:=xlValues, LookAt:=xlWhole)
            Set fn = sht.Range("B8:B95").Find(What:=Forename, LookIn:=xlValues, LookAt:=xlWhole)
           
            If Not sn Is Nothing And Not fn Is Nothing Then
                With ThisWorkbook.Sheets("Invoice")
                    nr = GetNextRow(ThisWorkbook.Sheets("Invoice"), "B")
               
                    .Range("B" & nr).Value = sht.Range("A1")
                    .Range("C" & nr).Value = sht.Range("C20") '<------CHANGE TO WHERE TOTAL FOR SHEET IS
                End With
            End If
        Next sht
       
        .Close _
            SaveChanges:=False
    End With

    Application.ScreenUpdating = True
   
End Sub

Function GetNextRow(sht As Worksheet, col As String) As Long
    GetNextRow = sht.Cells(sht.Rows.Count, col).End(xlUp).Offset(1).Row
End Function

 

[Marky_B]

Thank you Juddaaaa,

Very fast reply, however I am unable to run the code. I have pasted it into the workbook but it doesn't run?? when I press run nothing happens! I'm lost as other macros in the workbook run fine.

 

[juddaaaa]

You need to run it from another macro like this for example

Sub OtherMacro()   

    CopyToMaster _
        Bk:="Register_1.xlsx", _
        Surname:="Smith", _
        Forename:="John"

End Sub

Just change the names

 

[Marky_B]

Thanks again. I can now run the code.
It runs with no errors, I’ve changed the file name and it pops up no file as the code says, so that part works.
However when I run the code all that is put on the invoice sheet is the number 5 although “John” “Smith” is on every sheet in the register. It’s as if the code doesn’t check John Smith on every sheet in the register

 

[FatBoyClam]

Just a point of clarification - do the forename and surname need to be a matching pair? i.e. do they need to be on the same row.

@juddaaaa - correct me if I'm wrong, but that will update the invoice even if there's no John Smith, but there is a Bob Smith and a John Doe.

 

[Marky_B]

These are photos of what im trying to do. Hopefully they will help with the coding. I've added some information for reference.
If John Smith is searched then "SN" Smith & "FN" John are on the same line the total in column O is copied to the invoice
but if "SN" Doe & "FN" John then ignor

Thanks again

 

[juddaaaa]

Just a point of clarification - do the forename and surname need to be a matching pair? i.e. do they need to be on the same row.

@juddaaaa - correct me if I'm wrong, but that will update the invoice even if there's no John Smith, but there is a Bob Smith and a John Doe.

If Not sn Is Nothing And Not fn Is Nothing Then

If either name isn't found this would return False

 

[juddaaaa]

If Not sn Is Nothing And Not fn Is Nothing Then

If either name isn't found this would return False

@FatBoyClam Never mind. I've spotted what you mean now

@Marky_B
It's a bit easier now I've seen what you're working with

Sub CopyToMaster(Bk As String, Surname As String, Forename As String)

    Dim sn As Range, fn As Range
    Dim sht As Worksheet
    Dim nr As Long
  
    Application.ScreenUpdating = False

    If Dir(ThisWorkbook.Path & "\" & Bk) = "" Then
        MsgBox "Sorry, " & Bk & " does not exist.", vbInformation, "No such file"
        Exit Sub
    End If
  
    With Workbooks.Open(ThisWorkbook.Path & "\" & Bk, True, True)
        For Each sht In .Sheets
            Set sn = sht.Range("A8:A95").Find(What:=Surname, LookIn:=xlValues, LookAt:=xlWhole)
            Set fn = sht.Range("B8:B95").Find(What:=Forename, LookIn:=xlValues, LookAt:=xlWhole)
          
            If (Not sn Is Nothing And Not fn Is Nothing) Then
                If sn.Row = fn.Row Then
                    With ThisWorkbook.Sheets("Invoice")
                        .Select
                        .Range("B13").Select
                       
                        With ActiveCell
                            .Value = sht.Range("A1") '// Cell A1 from Register_1
                            .Offset(, 1).Value = sht.Range("O" & sn.Row).Value '// Cell O from the row where then name was found
                            .Offset(1).Select '// Move down 1 in Invoice sheet....B14,B15,B16,B17
                        End With
                    End With
                End If
            End If
        Next sht
      
        .Close _
            SaveChanges:=False
    End With

    Application.ScreenUpdating = True
  
End Sub

However, you're copying cell A1 from Register_1, but that cell is empty in your example