Hi Guys,
I am trying to get this code to work, and just keep hitting my head against the wall not being able to get it to work. Below is the code i have at the moment. It loops over the cells on the sheet, the loops over the combobox list entries, when match is found copies to the sheet defined in column 1 of the combobox. If a new sheet it needed it will create the sheet and copy as normal.
The problem i am having is getting any kind of error handling to work correctly.
1. if it find a cell on the sheet that is not in to combobox list the it needs to display a msgbox that says lookupVal "was not found......", i though i has the code working, it was only displaying the last cell value that it couldn't match rather than all of them.
2. I need it to produce a Msgbox once all the coping has finished, that will tell the user what has been copied at to what sheet. I.E. sheet"2780" has 30 rows copied to it, vbcr, Sheet "2759" has 10 rows copied to it. Total rows search in the Global sheet: 42. Is could be used at the same time to display the values that were not matched.
If this can be done with the code i have, then great, but if you are able to think of a better way to perform the task thats even beeter, i am still new to VBA and still trying to learn.
Thanks in advance for all the assistance.
I am trying to get this code to work, and just keep hitting my head against the wall not being able to get it to work. Below is the code i have at the moment. It loops over the cells on the sheet, the loops over the combobox list entries, when match is found copies to the sheet defined in column 1 of the combobox. If a new sheet it needed it will create the sheet and copy as normal.
The problem i am having is getting any kind of error handling to work correctly.
1. if it find a cell on the sheet that is not in to combobox list the it needs to display a msgbox that says lookupVal "was not found......", i though i has the code working, it was only displaying the last cell value that it couldn't match rather than all of them.
2. I need it to produce a Msgbox once all the coping has finished, that will tell the user what has been copied at to what sheet. I.E. sheet"2780" has 30 rows copied to it, vbcr, Sheet "2759" has 10 rows copied to it. Total rows search in the Global sheet: 42. Is could be used at the same time to display the values that were not matched.
If this can be done with the code i have, then great, but if you are able to think of a better way to perform the task thats even beeter, i am still new to VBA and still trying to learn.
Thanks in advance for all the assistance.
Code:
Private Sub CommandButton6_Click()
Dim i As Long, j As Long, lastG As Long, strWS As String, rngCPY As Range
Dim StartTime As Double
Dim SecondsElapsed As Double
With Application
.ScreenUpdating = False
.EnableEvents = False
.CutCopyMode = False
End With
StartTime = Timer
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
End If
If sheets("Global").Range("A3") = "" Then
MsgBox "The appears to be no application loaded." & vbLf & vbLf & "Please load" & " " & Range("C11") & " " & "App and Planet Info, then click button 2 and try again.", vbExclamation, "Invalid Operation"
Exit Sub
End If
On Error GoTo bm_Close_Out
' find last row
lastG = sheets("Global").Cells(Rows.Count, "Q").End(xlUp).row
If InStr(1, sheets("Payment Form").Range("A20").value, "THE VAT SHOWN IS YOUR OUTPUT TAX DUE TO CUSTOMS AND EXCISE") > 0 Then
If sheets("PAYMENT FORM").Range("L40") >= 1 Then
MsgBox "It appears you have already split the jobs, this operation can only be performed once.", vbExclamation, "Invalid Operation"
Exit Sub
Else
For j = 0 To Me.ComboBox2.ListCount - 1
currVal = Me.ComboBox2.List(j, 0) ' value to match
For i = 3 To lastG
lookupVal = sheets("Global").Cells(i, "Q") ' value to find
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 i
Next j
End If
Else
If sheets("PAYMENT FORM").Range("L35") >= 1 Then
MsgBox "It appears you have already split the jobs, this operation can only be performed once.", vbExclamation, "Invalid Operation"
Exit Sub
Else
For j = 0 To Me.ComboBox2.ListCount - 1
currVal = Me.ComboBox2.List(j, 0) ' value to match
For i = 3 To lastG
lookupVal = sheets("Global").Cells(i, "Q") ' value to find
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 i
Next j
End If
End If
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, 2)
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("C9").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("C9").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:
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
With Application
.ScreenUpdating = True
.EnableEvents = True
.CutCopyMode = True
End With
End Sub
