Error handling for if sheets exists when copying rows - vba

Question

following my post If cell value matches a UserForm ComboBox column, then copy to sheet.
I have managed to get the code to work to move the check the names and move then to the correct sheets.
The problem i am having is checking if the sheets exists. If it finds a match in the sheet and column 2 in the combobox but there is no sheet for the value then it crashes the code.
Once all the information has been copied to the relevant sheets, i would like it to display a msgbox telling the user how many rows of data have been copied to the respective sheets.
Dim i As Long, j As Long, lastG As Long, strWS As String, rngCPY As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
.CutCopyMode = False
End With
On Error GoTo bm_Close_Out
' find last row
lastG = sheets("Global").Cells(Rows.Count, "Q").End(xlUp).row
For i = 3 To lastG
lookupVal = sheets("Global").Cells(i, "Q") ' value to find
' loop over values in "details"
For j = 0 To Me.ComboBox2.ListCount - 1
currVal = Me.ComboBox2.List(j, 2) ' value to match
If lookupVal = currVal Then
Set rngCPY = sheets("Global").Cells(i, "Q").EntireRow
strWS = Me.ComboBox2.List(j, 1)
On Error GoTo bm_Need_Worksheet '<~~ if the worksheet in the next line does not exist, go make one
With Worksheets(strWS)
rngCPY.Copy
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown
End With
End If
Next j
Next i
GoTo bm_Close_Out
bm_Need_Worksheet:
On Error GoTo 0
With Worksheet
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsTemplate As Worksheet: Set wsTemplate = wb.sheets("Template")
Dim wsPayment As Worksheet: Set wsPayment = wb.sheets("Payment Form")
Dim wsNew As Worksheet
Dim lastRow2 As Long
Dim Contract As String: Contract = sheets("Payment Form").Range("C9").value
Dim SpacePos As Integer: SpacePos = InStr(Contract, "- ")
Dim Name As String: Name = Left(Contract, SpacePos)
Dim Name2 As String: Name2 = Right(Contract, Len(Contract) - Len(Name))
Dim NewName As String: NewName = strWS
Dim CCName As Variant: CCName = Me.ComboBox2.List(j, 0)
Dim lastRow As Long: lastRow = wsPayment.Range("U36:U53").End(xlDown).row
If InStr(1, sheets("Payment Form").Range("A20").value, "THE VAT SHOWN IS YOUR OUTPUT TAX DUE TO CUSTOMS AND EXCISE") > 0 Then
lastRow2 = wsPayment.Range("A23:A39").End(xlDown).row
Else
lastRow2 = wsPayment.Range("A18:A34").End(xlDown).row
End If
wsTemplate.Visible = True
wsTemplate.Copy before:=sheets("Details"): Set wsNew = ActiveSheet
wsTemplate.Visible = False
If InStr(1, sheets("Payment Form").Range("A20").value, "THE VAT SHOWN IS YOUR OUTPUT TAX DUE TO CUSTOMS AND EXCISE") > 0 Then
With wsPayment
For Each cell In .Range("A23:A39")
If Len(cell) = 0 Then
If sheets("Payment Form").Range("A20").value = "Network" Then
cell.value = NewName & " - " & Name2 & ": " & CCName
Else
cell.value = NewName & " - " & Name2 & ": " & CCName
End If
Exit For
End If
Next cell
End With
Else
With wsPayment
For Each cell In .Range("A18:A34")
If Len(cell) = 0 Then
If sheets("Payment Form").Range("A20").value = "Network" Then
cell.value = NewName & " - " & Name2 & ": " & CCName
Else
cell.value = NewName & " - " & Name2 & ": " & CCName
End If
Exit For
End If
Next cell
End With
End If
If InStr(1, sheets("Payment Form").Range("A20").value, "THE VAT SHOWN IS YOUR OUTPUT TAX DUE TO CUSTOMS AND EXCISE") > 0 Then
With wsNew
.Name = NewName
.Range("D4").value = wsPayment.Range("A23:A39").End(xlDown).value
.Range("D6").value = wsPayment.Range("L11").value
.Range("D8").value = wsPayment.Range("C9").value
.Range("D10").value = wsPayment.Range("C11").value
End With
Else
With wsNew
.Name = NewName
.Range("D4").value = wsPayment.Range("A18:A34").End(xlDown).value
.Range("D6").value = wsPayment.Range("L11").value
.Range("D8").value = wsPayment.Range("C9").value
.Range("D10").value = wsPayment.Range("C11").value
End With
End If
wsPayment.Activate
With wsPayment
.Range("J" & lastRow2 + 1).value = 0
.Range("L" & lastRow2 + 1).Formula = "=N" & lastRow2 + 1 & "-J" & lastRow2 + 1 & ""
.Range("N" & lastRow2 + 1).Formula = "='" & NewName & "'!L20"
.Range("U" & lastRow + 1).value = NewName & ": "
.Range("V" & lastRow + 1).Formula = "='" & NewName & "'!I21"
.Range("W" & lastRow + 1).Formula = "='" & NewName & "'!I23"
.Range("X" & lastRow + 1).Formula = "='" & NewName & "'!K21"
End With
End With
On Error GoTo bm_Close_Out
Resume
bm_Close_Out:
With Application
.ScreenUpdating = True
.EnableEvents = True
.CutCopyMode = True
End With
With help from Jeeped I have manage to get the code for copying the rows to the relevant sheets, and if the sheet doesn't exists then it create it. I just need help with problem two above.

Answer 1

Attempting to use a Worksheet Object that does not exist throws an error. If you catch that error and create a worksheet with the name that you are looking for, you can Resume back to the point where the error was thrown and continue your processing.
Private Sub CommandButton7_Click()
Dim i As Long, j As Long, lastG As Long, strWS As String, strMSG As String
dim rngHDR as range, rngCPY aS range
With Application
.ScreenUpdating = False
.EnableEvents = False
.CutCopyMode = False
End With
On Error GoTo bm_Close_Out
' find last row
lastG = Sheets("Global").Cells(Rows.Count, "Q").End(xlUp).Row
For i = 3 To lastG
lookupVal = Sheets("Global").Cells(i, "Q") ' value to find
' loop over values in "details"
For j = 0 To Me.ComboBox2.ListCount - 1
currVal = Me.ComboBox2.List(j, 2) ' value to match
If lookupVal = currVal Then
set rngHDR = Sheets("Global").Cells(1, "Q").EntireRow
set rngCPY = Sheets("Global").Cells(i, "Q").EntireRow
strWS = Me.ComboBox2.List(j, 1)
On Error GoTo bm_Need_Worksheet '<~~ if the worksheet in the next line does not exist, go make one
With WorkSheets(strWS)
rngCPY .copy
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown
End With
exit for
End If
Next j
if j >= Me.ComboBox2.ListCount then _
strMSG = strMSG & "Not found: " & lookupVal & chr(10)
Next i
GoTo bm_Close_Out
bm_Need_Worksheet:
On Error GoTo 0
With Worksheets.Add(after:=Sheets(Sheets.Count))
.Name = strWS
'maybe make a header row here; watch out you do not lose your copy
rngHDR.copy destination:=.cells(1, 1)
End With
On Error GoTo bm_Close_Out
Resume
bm_Close_Out:
With Application
.ScreenUpdating = True
.EnableEvents = True
.CutCopyMode = False
End With
debug.print strMSG
'the next is NOT recommended as strMSG could possibly be VERY long
'if cbool(len(strMSG)) then msgbox strMSG
End Sub
There is a question about whether the new worksheet needs a column header label row but that should be fairly easily rectified.

Answer 2

You could use a function like this :
Sub test_atame()
Dim Ws As Worksheet
Set Ws = Sheet_Exists(ThisWorkbook, "Sheet1")
Set Ws = Sheet_Exists(ActiveWorkbook, "Sheet1")
End Sub
Here is the function :
Public Function Sheet_Exists(aWorkBook As Workbook, Sheet_Name As String) As Worksheet
Dim Ws As Worksheet, _
SExistS As Boolean
SExistS = False
For Each Ws In aWorkBook.Sheets
If Ws.Name <> Sheet_Name Then
Else
SExistS = True
Exit For
End If
Next Ws
If SExistS Then
Set Sheet_Exists = aWorkBook.Sheets(Sheet_Name)
Else
Set Sheet_Exists = Nothing
MsgBox "The sheet " & Sheet_Name & " wasn't found in " & aWorkBook.Name & vbCrLf & _
"Break code to check and correct.", vbCritical + vbOKOnly
End If
End Function

Answer 3

Maybe a check like:
Public Function SheetExists(ByVal Book As Workbook, ByVal SheetName As String) As Boolean
On Error Resume Next
Dim wsTest As Worksheet
Set wsTest = Book.Worksheets(SheetName)
If Not wsTest Is Nothing Then SheetExists = True
End Function