Msgbox for number of rows copied to what sheet - vba

Question

With help from many helpful people on here I have got to the point where the code does exactly what I need it to do!
I am really struggling with the MsgBox at the end that display how many rows have been copied to each sheet. I would also like it to display if there were any non-matches from the Global sheet in the same MsgBox. If no non-matches were found then this part can be omitted.
Below is the code i have that searches the sheet for the values in column Q and the finds the match in the ComboBox2 on the UserForm. This tells what sheet the rows need to be copied to, and if a new sheet is needed then also what to name it along with some other needed information.
Private Sub CommandButton1_Click()
Dim i As Long, j As Long, k As Long, strWS As String, rngCPY As Range
Dim noFind As Variant: noFind = UserForm2.ComboBox2.List '<~~~ get missed items
With Application: .ScreenUpdating = False: .EnableEvents = False: .CutCopyMode = False: End With
If Range("L9") = "" Then: MsgBox "You can't Split the Jobs at this stage. " & vbLf & vbLf & "Please create the form for the Sub-Contractor First." & vbLf & vbLf & "Please press Display Utilities to create form.", vbExclamation, "Invalid Operation": Exit Sub
Dim lastG As Long: lastG = sheets("Global").Cells(Rows.Count, 17).End(xlUp).row
Dim cVat As Boolean: cVat = InStr(1, sheets("Payment Form").Range("A20").value, "THE VAT SHOWN IS YOUR OUTPUT TAX DUE TO CUSTOMS AND EXCISE")
If sheets("PAYMENT FORM").Cells(35 - cVat * 5, 12) >= 1 Then: MsgBox "It appears you have already split the jobs, this operation can only be performed once.", vbExclamation, "Invalid Operation": Exit Sub
For j = 0 To UserForm2.ComboBox2.ListCount - 1
noFind(j, 4) = 0
For i = 3 To lastG
If noFind(j, 0) = sheets("Global").Cells(i, 17) Then
k = i
strWS = UserForm2.ComboBox2.List(j, 1)
On Error Resume Next '<~~ if the worksheet in the next line does not exist, go make one
If Len(Worksheets(strWS).Name) = 0 Then
With ThisWorkbook
On Error GoTo 0
Dim nStr As String: With sheets("Payment Form").Range("C9"): nStr = Right(.value, Len(.value) - Len(Left(.value, InStr(.value, "- ")))): End With
Dim CCName As Variant: CCName = UserForm2.ComboBox2.List(j, 2)
Dim lastRow As Long: lastRow = sheets("Payment Form").Range("U36:U53").End(xlDown).row
Dim strRng As String: strRng = Array("A18:A34", "A23:A39")(-1 * cVat)
Dim lastRow2 As Long: lastRow2 = sheets("Payment Form").Range(strRng).End(xlDown).row
Dim wsTemplate As Worksheet: Set wsTemplate = ThisWorkbook.sheets("Template")
Dim wsNew As Worksheet
With sheets("Payment Form")
For Each cell In .Range(strRng)
If Len(cell) = 0 Then
If sheets("Payment Form").Range("C9").value = "Network" Then
cell.Offset.value = strWS & " - " & nStr & ": " & CCName
Else
cell.Offset.value = strWS & " -" & nStr & ": " & CCName
End If
Exit For
End If
Next cell
End With
With wsNew
wsTemplate.Visible = True
wsTemplate.Copy before:=sheets("Details"): Set wsNew = ActiveSheet
wsTemplate.Visible = False
wsNew.Name = strWS
wsNew.Range("D4").value = sheets("Payment Form").Range(strRng).End(xlDown).value
wsNew.Range("D6").value = sheets("Payment Form").Range("L11").value
wsNew.Range("D8").value = sheets("Payment Form").Range("C9").value
wsNew.Range("D10").value = sheets("Payment Form").Range("C11").value
End With
With .sheets("Payment Form")
.Activate
.Range("J" & lastRow2 + 1).value = 0
.Range("L" & lastRow2 + 1).Formula = "=N" & lastRow2 + 1 & "-J" & lastRow2 + 1 & ""
.Range("N" & lastRow2 + 1).Formula = "='" & strWS & "'!L20"
.Range("U" & lastRow + 1).value = strWS & ": "
.Range("V" & lastRow + 1).Formula = "='" & strWS & "'!I21"
.Range("W" & lastRow + 1).Formula = "='" & strWS & "'!I23"
.Range("X" & lastRow + 1).Formula = "='" & strWS & "'!K21"
End With
End With
End If '<~~~ end new sheet
On Error GoTo 0
While sheets("Global").Cells(k + 1, 17).value = noFind(j, 0) And k < lastG
k = k + 1
Wend
Set rngCPY = sheets("Global").Range("Q" & i & ":Q" & k).EntireRow
With Worksheets(strWS)
rngCPY.Copy
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown
End With
noFind(j, 4) = noFind(j, 4) + k - i + 1
i = k
End If
Next i
Next j
With Application: .ScreenUpdating = True: .EnableEvents = True: .CutCopyMode = True: End With
'noFind(x, y) > x = item / y: 0 = name / y: 4 = counter
noFind(0, 0) = noFind(0, 0) & " " & noFind(0, 4) & " times copied"
For i = 1 To UBound(noFind)
noFind(0, 0) = noFind(0, 0) & vbLf & noFind(i, 0) & " " & noFind(i, 4) & " times copied"
Next
MsgBox noFind(0, 0)
End Sub
This is what is currently being displayed by the MsgBox:
This is how I want the MsgBox to display the information:
I want it to show the sheet names, then how many rows have been copied to it.
Below that the total number of rows copied.
Then if required, below that display errors found on the global sheet along with how many times you found that value. I.e (BRERRORS) <- This is the cell value.
If possible below that, maybe a total number of errors found on the sheet as well.
At the very bottom, a total number of rows that were searched in the global sheet, this will be used for comparison, so if the total number of rows copied doesn't match the total number of the global sheet then the user will know they need to copied some rows manually after checking the rows value.
If it helps here is the original code without the code for the MsgBox, if you can think of a better way to do it.
Private Sub btnSplitJobs_Click()
Dim i As Long, j As Long, k As Long, strWS As String, rngCPY As Range
With Application: .ScreenUpdating = False: .EnableEvents = False: .CutCopyMode = False: End With
If Range("L9") = "" Then: MsgBox "You can't Split the Jobs at this stage. " & vbLf & vbLf & "Please create the form for the Sub-Contractor First." & vbLf & vbLf & "Please press Display Utilities to create form.", vbExclamation, "Invalid Operation": Exit Sub
Dim lastG As Long: lastG = sheets("Global").Cells(Rows.Count, "Q").End(xlUp).row
Dim cVat As Boolean: cVat = InStr(1, sheets("Payment Form").Range("A20").value, "THE VAT SHOWN IS YOUR OUTPUT TAX DUE TO CUSTOMS AND EXCISE")
If sheets("PAYMENT FORM").Cells(35 - cVat * 5, 12) >= 1 Then: MsgBox "It appears you have already split the jobs, this operation can only be performed once.", vbExclamation, "Invalid Operation": Exit Sub
For j = 0 To UserForm2.ComboBox2.ListCount - 1
currval = UserForm2.ComboBox2.List(j, 0)
For i = 3 To lastG
If currval = sheets("Global").Cells(i, "Q") Then
k = i
strWS = UserForm2.ComboBox2.List(j, 1)
On Error Resume Next '<~~ if the worksheet in the next line does not exist, go make one
If Len(Worksheets(strWS).Name) = 0 Then
With ThisWorkbook
On Error GoTo 0
Dim nStr As String: With sheets("Payment Form").Range("C9"): nStr = Right(.value, Len(.value) - Len(Left(.value, InStr(.value, "- ")))): End With
Dim CCName As Variant: CCName = UserForm2.ComboBox2.List(j, 2)
Dim lastRow As Long: lastRow = sheets("Payment Form").Range("U36:U53").End(xlDown).row
Dim strRng As String: strRng = Array("A18:A34", "A23:A39")(-1 * cVat)
Dim lastRow2 As Long: lastRow2 = sheets("Payment Form").Range(strRng).End(xlDown).row
Dim wsTemplate As Worksheet: Set wsTemplate = ThisWorkbook.sheets("Template")
Dim wsNew As Worksheet
With sheets("Payment Form")
For Each cell In .Range(strRng)
If Len(cell) = 0 Then
If sheets("Payment Form").Range("C9").value = "Network" Then
cell.Offset.value = strWS & " - " & nStr & ": " & CCName
Else
cell.Offset.value = strWS & " -" & nStr & ": " & CCName
End If
Exit For
End If
Next cell
End With
With wsNew
wsTemplate.Visible = True
wsTemplate.Copy before:=sheets("Details"): Set wsNew = ActiveSheet
wsTemplate.Visible = False
wsNew.Name = strWS
wsNew.Range("D4").value = sheets("Payment Form").Range(strRng).End(xlDown).value
wsNew.Range("D6").value = sheets("Payment Form").Range("L11").value
wsNew.Range("D8").value = sheets("Payment Form").Range("C9").value
wsNew.Range("D10").value = sheets("Payment Form").Range("C11").value
End With
With .sheets("Payment Form")
.Activate
.Range("J" & lastRow2 + 1).value = 0
.Range("L" & lastRow2 + 1).Formula = "=N" & lastRow2 + 1 & "-J" & lastRow2 + 1 & ""
.Range("N" & lastRow2 + 1).Formula = "='" & strWS & "'!L20"
.Range("U" & lastRow + 1).value = strWS & ": "
.Range("V" & lastRow + 1).Formula = "='" & strWS & "'!I21"
.Range("W" & lastRow + 1).Formula = "='" & strWS & "'!I23"
.Range("X" & lastRow + 1).Formula = "='" & strWS & "'!K21"
End With
End With
End If '<~~~ end new sheet
While sheets("Global").Cells(k + 1, 17).value = currval And k < lastG
k = k + 1
Wend
Set rngCPY = sheets("Global").Range("Q" & i & ":Q" & k).EntireRow
With Worksheets(strWS)
rngCPY.Copy
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown
End With
i = k
End If
Next i
Next j
With Application: .ScreenUpdating = True: .EnableEvents = True: .CutCopyMode = True: End With
End Sub