Sub SearchPupils()
Dim cc As Range
With Sheets("Pupils")
For Each cc In .Range("A3", "A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
CopyToMaster _
FullName:=Join(Array(Trim(cc.Offset(, 1)), Trim(cc)), " ")
Next cc
End With
End Sub
Sub CopyToMaster(FullName As String)
'// Declare some variables
Dim fso As Object, fldr As Object, fl As Object
Dim cc As Range
Dim sht As Worksheet
Dim InRegister As String
Dim nr As Long
'// Turn off Screen Updating
Application.ScreenUpdating = False
'// Create objects to work with File System
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder(ThisWorkbook.Path)
'// Set Number of first output row in Invoice
nr = 13
'// Loop through each file in the folder whos name begins with "Register_"
'// and then search Range B8:B95 of each sheet in those files for the value
'// passed in as FullName
For Each fl In fldr.Files
If InStr(fso.GetBaseName(fl), "Register_") Then
With Workbooks.Open(fl.Path, True, True)
For Each sht In .Sheets
For Each cc In sht.Range("B8:B95")
If Join(Array(cc.Value, cc.Offset(, -1).Value), " ") = FullName Then
With ThisWorkbook
.Activate
'// Fill out the Invoice with information found in the files
With .Sheets("Invoice")
.Activate
.Range("B9") = FullName '// INSERT NAME UNDER BILL TO
.Range("B" & nr).Select '// SELECT FIRST OUTPUT ROW
With ActiveCell
.Value = sht.Range("A2") '// DESCRIPTION
.Offset(, 1) = sht.Range("O" & cc.Row) '// NO. OF SESSIONS
InRegister = Left(.Value, Len(.Value) - (Len(.Value) - InStrRev(.Value, " Week") + 1))
.Offset(, 2) = Sheets("Home").Range("M3:M4").Find(What:=InRegister, LookIn:=xlValues).Offset(, 1) '// COST PER SESSION
.Offset(1).Select '// MOVE DOWN ONE ROW
End With
End With
End With
nr = nr + 1
Exit For
End If
Next cc
Next sht
.Close _
SaveChanges:=False
End With
End If
Next fl
'// Save Invoice
SaveInvWithNewName
'// Turn on Screen Updating
Application.ScreenUpdating = True
End Sub
Sub SaveInvWithNewName()
'Saves the invoice to the invoice folder with invoice name
Dim NewFN As Variant
PostToRegister
' Copy Invoice to a new workbook
Sheets("Invoice").Select
ActiveSheet.Copy
'Save active workbook as excel
NewFN = "C:\Project\Invoices\Inv" & Range("E9").Value & ".xlsx"
ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook
'Save active workbook as PDF
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Project\Invoices\Inv" & Range("E9").Value & ".pdf"
ActiveWorkbook.Close
NextInvoice
Sheets("Home").Select
Range("A1").Select
End Sub
Sub PostToRegister()
'Copies Invoice data to the Invoice Register
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Set WS1 = Worksheets("Invoice")
Set WS2 = Worksheets("Register")
'Figures out which row is the next row
NextRow = WS2.Cells(Rows.Count, 1).End(xlUp).Row + 1
'Write the Information to the Register
WS2.Cells(NextRow, 1).Resize(1, 4).Value = Array(WS1.Range("E8"), WS1.Range("E9"), WS1.Range("B9"), Range("InvTotal"))
End Sub
Sub NextInvoice()
'Adds +1 to the invoice then clears all data
Sheets("Invoice").Select
Range("E9").Value = Range("E9").Value + 1
Range("B8:B10").ClearContents
Range("B13:D28").ClearContents
End Sub
