Help needed if match not found

M

Marky_B

New Member
Joined
Feb 4, 2020
Messages
39
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
could you please help with the following code. It works fantastic however if the name is in the pupil list but not on a register it debugs. easy way to sort this is to delete the name in the pupil list and restart. It would be helpful if someone could help do either of the following with explanation to help me with my coding. Thank you

1. Ignore if the name doesn't exist in the list and move on
2. have a popup that says "this name "insert name" not found, would you like to delete from the list and proceed?"

here is my code

VBA Code: 
'search for pupils names and joins them together
    Sub SearchPupils()

'Declare variables
    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:B128 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:B172")
                        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("CostPerSession").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
 
Last edited by a moderator:

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Sort by date Sort by votes
I didn't find any possible code line to make a error because of pupil names not in the list.

Is it possible that your sub code "SaveInvWithNewName" makes the error ?
And "SaveInvWithNewName" you didn't show in your thread.
 
Upvote 0
Here is my whole VBA Code. I'm not a professional and its written as I've picked bits up so it maybe a little messy. Thank you for looking


'search for pupils names and joins them together
Sub SearchPupils()

'Declare variables
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:B128 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:B172")
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("CostPerSession").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

'Saves the invoice to the invoice folder with invoice name
Sub SaveInvWithNewName()

'Declare some variables
Dim NewFN As Variant
PostToRegister

'Turn off Screen Updating
Application.ScreenUpdating = False

'Copy Invoice to a new workbook
Sheets("Invoice").Select
ActiveSheet.Copy

'Print1

'sets the file path location and name of file
NewFN = ThisWorkbook.Path & "\Invoices\Inv" & Range("E9") & " - " & Range("B9").Value

'save active workbook as excel
ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook

'save active workbook as PDF
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NewFN

ActiveWorkbook.Close
NextInvoice
Sheets("Home").Select
Range("A1").Select

'Turn on Screen Updating
Application.ScreenUpdating = True

End Sub
'Copies Invoice data to the Invoice Register
Sub PostToRegister()

'Declare some variables
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Set WS1 = Worksheets("Invoice")
Set WS2 = Worksheets("Summary")

'Clears cells
Range("K10:L10").ClearContents

'Figures out which row is the next row
nextrow = WS2.Cells(Rows.Count, 2).End(xlUp).Row + 1

'Write names to cells B2 and C2 on WS1
WS1.Range("K10") = Left(WS1.Range("B9"), InStr(WS1.Range("B9"), " ") - 1)
WS1.Range("L10") = Mid(WS1.Range("B9"), InStr(WS1.Range("B9"), " ") + 1)

'Write the Information to the Register
WS2.Cells(nextrow, 2).Resize(1, 7).Value = Array(WS1.Range("L10"), WS1.Range("K10"), WS1.Range("E8"), WS1.Range("E9"), WS1.Range("InvBC"), WS1.Range("InvASC"), WS1.Range("InvTotal"))
GetTotals

End Sub
'Copies Invoice data to the Invoice Register
Sub PostToRegisteradhoc()

'Declare some variables
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Set WS1 = Worksheets("Invoice")
Set WS2 = Worksheets("Summary")
Dim NewFN As Variant

'Turn off Screen Updating
Application.ScreenUpdating = False

'Copy Invoice to a new workbook
Sheets("Invoice").Select
ActiveSheet.Copy

'sets the file path location and name of file
'NewFN = ThisWorkbook.Path & "\Invoices\Inv" & Range("E9").Value '//SAVES FILE AS Inv****
NewFN = ThisWorkbook.Path & "\Invoices\Inv" & Range("E9") & " - " & Range("B9").Value '//SAVES FILE AS Inv**** - firstname lastname


'save active workbook as excel
ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook

'save active workbook as PDF
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NewFN

ActiveWorkbook.Close


'Figures out which row is the next row
nextrow = WS2.Cells(Rows.Count, 2).End(xlUp).Row + 1

'Write names to cells B2 and C2 on WS1
WS1.Range("K10") = Left(WS1.Range("B9"), InStr(WS1.Range("B9"), " ") - 1)
WS1.Range("L10") = Mid(WS1.Range("B9"), InStr(WS1.Range("B9"), " ") + 1)

'Write the Information to the Register
WS2.Cells(nextrow, 2).Resize(1, 7).Value = Array(WS1.Range("L10"), WS1.Range("K10"), WS1.Range("E8"), WS1.Range("E9"), WS1.Range("InvBC"), WS1.Range("InvASC"), WS1.Range("InvTotal"))

'adds 1 to invoice
Sheets("Invoice").Select
Range("E9").Value = Range("E9").Value + 1
Range("B8:B10").ClearContents
Range("B13:D28").ClearContents
Range("K10:L10").ClearContents

Sheets("Home").Select
Range("A1").Select

'Turn on Screen Updating
Application.ScreenUpdating = True

End Sub

'Gets the totals for the summaries page
Sub GetTotals()

'autosums the Breakfast Club column
lastrow = ThisWorkbook.Sheets("Summary").Cells(Rows.Count, 6).End(xlUp).Row
ThisWorkbook.Sheets("Summary").Range("F" & lastrow + 1) = WorksheetFunction.Sum(ThisWorkbook.Sheets("Summary").Range("F2:F" & lastrow))

'autosums the After School Club column
lastrow = ThisWorkbook.Sheets("Summary").Cells(Rows.Count, 7).End(xlUp).Row
ThisWorkbook.Sheets("Summary").Range("G" & lastrow + 1) = WorksheetFunction.Sum(ThisWorkbook.Sheets("Summary").Range("G2:G" & lastrow))

'autosums the invoice column column
lastrow = ThisWorkbook.Sheets("Summary").Cells(Rows.Count, 8).End(xlUp).Row
ThisWorkbook.Sheets("Summary").Range("H" & lastrow + 1) = WorksheetFunction.Sum(ThisWorkbook.Sheets("Summary").Range("H2:H" & lastrow))

End Sub

'Adds +1 to the invoice then clears all data
Sub NextInvoice()

Sheets("Invoice").Select
Range("E9").Value = Range("E9").Value + 1
Range("B8:B10").ClearContents
Range("B13:D28").ClearContents

End Sub

'toggles the button on homepage
Sub MoveBtn()
With Sheet1

If .Range("B1").Value = "Breakfast Club" Then
.Shapes("MoveBtn").IncrementLeft 30
.Range("B1").Value = "AfterSchool Club"
Else:
.Shapes("MoveBtn").IncrementLeft -30
.Range("B1").Value = "Breakfast Club"
End If

End With

End Sub

Sub Print1()
' PRINTING HAS BEEN TURNED OFF
'ActiveWindow.SelectedSheets.PrintOut copies:=1, collate:=True, IgnorePrintAreas:=False

End Sub

'Saves the summary to the summaries folder with todays date
Sub SaveSummary()

'Declare some variables
Dim NewFN As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
NewFN = ThisWorkbook.Path & "\Summaries\" & "InvSummary - " & Format(Date, "dd.mm.yy")

Sheets("Summary").Copy

'Copy Summary to a new workbook
With ActiveWorkbook

'Save as excel
.SaveAs NewFN & ".xlsx", FileFormat:=xlOpenXMLWorkbook

'Save as PDF
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NewFN & ".pdf"
.Close
End With
Sheets("Summary").Range("A2:H200").ClearContents
Sheets("Home").Select
Range("A1").Select

'Turn on Screen Updating
Application.ScreenUpdating = True

End Sub
'send email to parent with invoice attached
Sub send_email_with_invoice()

'Declare some variables
Dim o As Outlook.Application
Set o = New Outlook.Application
Dim omail As Outlook.MailItem
Dim i As Long

'start loop for making emails
For i = 2 To Range("a200").End(xlUp).Row
Set omail = o.CreateItem(olMailItem)
With omail
'In the email
.Body = "Dear sir / madam"
'who it's being sent to
.To = Cells(i, 2).Value
'email subject
.Subject = "Your Extended Schools Invoice"

'file being attached
.Attachments.Add Cells(i, 4).Value
'display on the screen
.Display
'sends the email
.send

End With

Next


End Sub
 
Upvote 0
What line is causing the error? The easiest way would be to add this right before it.
VBA Code: 
on error resume next
 
Upvote 0
If the name is in the pupil list but not on a register, it debugs.
Could tell me which code line it stops at ?
 
Upvote 0
Try.
I add 6 new lines in your sub "CopyToMaster", and each line I have marked.
These 6 lines are all about a new variable "myCheck_FullName_Exist " .

I suppose if your "FullName" is not found in all range("B8:B172") of every Sheets,
then we should pass the sub "SaveInvWithNewName".

HTH.

PS. Kindly to use the VBA format like below.
VBA Code: 
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:B128 of each sheet in those files for the value
    '// passed in as FullName
    myCheck_FullName_Exist = 0  'the 1st line to add
    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:B172")
                        If Join(Array(cc.Value, cc.Offset(, -1).Value), " ") = FullName Then
                            myCheck_FullName_Exist = 1 'the 2nd line to add
                            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("CostPerSession").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
   
    If myCheck_FullName_Exist = 1 Then 'the 3rd line to add
        '// Save Invoice
        SaveInvWithNewName
    Else 'the 4th line to add
        MsgBox "The pupil " & FullName & " not found." 'the 5th line to add
    End If 'the 6th line to add
    '// Turn on Screen Updating
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
@Marky_B
As already mentioned, when posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug. My signature block below has more details. I have added the tags in post 1 for you this time. 😊
 
Upvote 0
Hello,
Thank you for looking at this, it worked a treat.
I have now been given another curve ball though!!! The code above works perfectly when the excel file is stored on the computers :C drive. We have now moved to SharePoint though and the excel now no longer runs. The document is stored in SharePoint but I have "synced" the document library to the local machine. I hope this makes sense.
I don't know where to start please help.

Thank you
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Doesn’t work when the file is on SharePoint
Replies
1
Views
1K
PeteWright
PeteWright
S
  • Solved
If Dir(FullName) <> vbNull String Then Giving Runtime Error 52
Replies
5
Views
297
StedDOOM
S
M
  • Question Question
Add text before pasting pic in outlook
Replies
2
Views
79
DanteAmor
DanteAmor
J
  • Solved
Run time error for Worksheet Change in VBA
2
Replies
17
Views
430
jtemp57
J
B
  • Locked
  • Question Question
copy range of cells
Replies
1
Views
70
Joe4
Joe4

Forum statistics

Threads
1,223,908
Messages
6,175,306
Members
452,633
Latest member
DougMo

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top