Match cell value to a combobox row value

Question

I'm trying to figure out a different method of running a piece of code.

Basically what my code is doing at the moment is, looping though column Q in the Global sheet, then looping though Combobox2, when it finds a match the entire rows get moved to the sheet reference in column 1 of the combobox.

Is it possible to use the Match function to achieve the same results and speed up the code??

This is currently the code I'm using, it does what I need it to do, but I cannot get error handling working for it. And it there are many rows of data to loop through it can take a long time!

Option 1:

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

Option 2:

Private Sub CommandButton1_Click()
Dim j As Long, strWS As String, rngCPY As Range, FirstAddress As String, sSheetsWithData As String
Dim sSheetsWithoutData As String, lSheetRowsCopied As Long, lAllRowsCopied As Long, bFound As Boolean, sOutput As String

Dim StartTime As Double
Dim SecondsElapsed As Double

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .CutCopyMode = False
    .EnableEvents = False
End With

StartTime = Timer

On Error GoTo bm_Close_Out

For j = 0 To UserForm2.ComboBox2.ListCount - 1
        bFound = False
        currval = UserForm2.ComboBox2.List(j, 0) ' value to match
       With sheets("Global")
            Set rngCPY = sheets("Global").Range("Q:Q").Find(currval, LookIn:=xlValues)
            If Not rngCPY Is Nothing Then
            bFound = True
                lSheetRowsCopied = 0
                FirstAddress = rngCPY.Address
                Do
                    lSheetRowsCopied = lSheetRowsCopied + 1
                    strWS = UserForm2.ComboBox2.List(j, 1)
                    On Error GoTo bm_Need_Worksheet
                    With Worksheets(strWS)
                        rngCPY.EntireRow.Copy
                        .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown
                    End With
                    Set rngCPY = sheets("Global").Range("Q:Q").FindNext(rngCPY)
                Loop Until rngCPY Is Nothing Or rngCPY.Address = FirstAddress
            Else
                bFound = False
            End If
            If bFound Then
                sSheetsWithData = sSheetsWithData & "    " & strWS & " (" & lSheetRowsCopied & ")" & vbLf
                lAllRowsCopied = lAllRowsCopied + lSheetRowsCopied
            End If
        End With
Next j

bm_Need_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 = UserForm2.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

    On Error GoTo bm_Close_Out
    Resume

bm_Close_Out:
    If sSheetsWithData <> vbNullString Then
        sOutput = "# of rows copied to sheets:" & vbLf & vbLf & sSheetsWithData & vbLf & _
            "Total rows copied = " & lAllRowsCopied & vbLf & vbLf
    Else
        sOutput = "No sheets contained data to be copied" & vbLf & vbLf
    End If

    If sSheetsWithoutData <> vbNullString Then
        sOutput = sOutput & "Sheets with no rows copied:" & vbLf & vbLf & sSheetsWithoutData
    Else
        sOutput = sOutput & "All sheets had data that was copied."
    End If

    If sOutput <> vbNullString Then MsgBox sOutput, , "Copy Report"

    Set rngCPY = Nothing

SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .CutCopyMode = True
    .EnableEvents = True
End With

End Sub

@ChrisUnbroken. I have included the code i am currently using. — atame, Nov 20 '15 at 13:23
You could look into the [Find.Range](https://msdn.microsoft.com/de-de/library/office/ff839746.aspx)-Method — MGP, Nov 20 '15 at 13:23
@MarcoGetrost. Hi, could you please show me how to do this, i am still very new to VBA, and it has taken me a long time to get the code to this stage! — atame, Nov 20 '15 at 13:23
related: This is the second time in recent memory that I've seen `.CutCopyMode = True` in code just before exiting a sub. If anything, it should be `.CutCopyMode = FALSE` if it is needed at all. — , Nov 20 '15 at 15:07
@Jeeped. I turn .cutcopymode of at the start, then re-enable it once the code has finished? is that not correct? — atame, Nov 20 '15 at 15:15
@atame - Too much for a comment. Please see [Should I turn .CutCopyMode back on before exiting my sub procedure?](http://stackoverflow.com/questions/33833318/should-i-turn-cutcopymode-back-on-before-exiting-my-sub-procedure/33833319#33833319). — , Nov 20 '15 at 18:10

Dirk Reichel · Accepted Answer · 2015-11-23T17:57:42.110

OK... It's more like a try than an answer. pls check if that is working and if it is faster.

Use this macro only with a copy of your workbook!

Private Sub CommandButton2_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

  '~~~ acivate next line to sort (will speed up a lot)
  'Sheets("Global").Range("A3:R" & Cells(Rows.Count, 17).End(xlUp).row).Sort cells(3,17), 1

  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 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 + 1
            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 + 1
            Dim wsNew As Worksheet: .Sheets("Template").Copy .Sheets(.Sheets.Count): Set wsNew = .Sheets(.Sheets.Count): wsNew.Move .Sheets("Details")
            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
              .Visible = -1
              .Name = strWS
              .Cells(4, 4).Value = Sheets("Payment Form").Range(strRng).End(xlDown).Value
              .Cells(6, 4).Value = Sheets("Payment Form").Cells(12, 12).Value
              .Cells(8, 4).Value = Sheets("Payment Form").Cells(9, 3).Value
              .Cells(10, 4).Value = Sheets("Payment Form").Cells(11, 3).Value
            End With
            With .Sheets("Payment Form")
              .Activate
              .Cells(lastRow2, 10).Value = 0
              .Cells(lastRow2, 12).Formula = "=N" & lastRow2 & "-J" & lastRow2 & ""
              .Cells(lastRow2, 14).Formula = "='" & strWS & "'!L20"
              .Cells(lastRow, 21).Value = strWS & ": "
              .Cells(lastRow, 22).Formula = "='" & strWS & "'!I21"
              .Cells(lastRow, 23).Formula = "='" & strWS & "'!I23"
              .Cells(lastRow, 24).Formula = "='" & strWS & "'!K21"
            End With
          End With
        End If
        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

At first: you may add some empty lines for better understanding...

Most parts are just shortened by view (they still do tha same).

When using the sort option, it will copy/paste all rows for each keyword in one step. That not only sounds faster... However, you may resort at the end again

Pls check if it works with your real workbook (copy of it, but with all data inside). I haven't done any "indeep speed tuning".

I have tried the code, and it doesn't create the new sheets if required. If the sheets already there it copies that information but leaves the rest. Would you like me to upload a copy of the workbook? Thanks — atame, Nov 23 '15 at 09:07
https://drive.google.com/file/d/0B1Z1ZIW5rn8JY0pXSXpyeHMwa0E/view?usp=sharing Here is the file, i have removed some things, for data security, but you should have everything you need. you code is under CommandButton3. Thanks — atame, Nov 23 '15 at 10:29
@atame i'll check whats not working correctly... may take a while... i'll write a comment as soon as i'm finished — Dirk Reichel, Nov 23 '15 at 10:34
look like i didnt change come of the fields, on the Global sheet, if you change some of the BRRepairs in column Q to BRVoids, or even BRPPM, you should see where it fails. — atame, Nov 23 '15 at 11:10
@atame i have edited my answer... please check it. if sorting is ok, then we can change to `Match` to speed it up a second time (if still needed) — Dirk Reichel, Nov 23 '15 at 13:33
@Direk Reichel. I have tried the code in my doc. It works Very Fast!. The problem is when coping to the new sheet, it doesnt paste the data is the correct place. I have edited my OP to include a screenshot of what is happening. Thanks — atame, Nov 23 '15 at 13:55
@atame im confused... when deleting the sheet and executing the macro everything went fine... i may need a different check where to paste... the "brockley: repairs" causes this... it checks for the last filled cell in column A: `.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown` — Dirk Reichel, Nov 23 '15 at 14:33
i have fixed it. it was a weird one, for some reason they seemed to be copies of the Template worksheet that had that Brockley: Repairs take on line 18 which was causing the issue. I have one more favor to ask. could you help with the error handling. If there is a value in the Global sheet that doesnt match the combobox values, then at the end a msgbox would show all value that were not copied. and lastly if you have a look at Option2 in my OP, there is code is there that create a msgbox that tell me what has been copied where, can we code this in?? thanks — atame, Nov 23 '15 at 14:42
oh and as for speed it look 1.08 seconds. for the 41 rows, creating 3 new sheets. Perfect!! — atame, Nov 23 '15 at 14:43
How would i use sheets("Global").Range("A3:R" & Cells(Rows.Count, 17).End(xlUp).row).Sort Cells(3, 17), 1. To speed up the process?? Thanks — atame, Nov 23 '15 at 15:12
@atame done another edit for your msgbox... the sorting speeds up cus each keyword only has one copy/paste. the `While Sheets("Globa...` does the work for checking the range (when sorted you will allways get all matches at once and you can set an `Exit For` when a match is found) but with times below 2 sec, it should be fast enough to do it without it... — Dirk Reichel, Nov 23 '15 at 16:52
Ah that makes sense with the timings. With the msgbox, is it possible for it to show how many rows were copied to each sheets alonf wiht total rows copied? And with the missed entries, i was looking for the ones from the sheet rather than the combobox. for example, if there was BRERROR on the global sheet and there was no match in the combobox then it would display BRERRORS, in the missed entries? Apart from that it works great and you are a lengend!!! Thanks — atame, Nov 23 '15 at 17:09
Something similar to what i have posted in the original post, but where it says "sheets with nor rows copied" it would say BRERRORS not found. or if there we no missing entries found then, "all rows have been copied successfully"? Thanks — atame, Nov 23 '15 at 17:11
That you so much, i really appreciate all the help you have provided!! SuperUser — atame, Nov 23 '15 at 17:22
@atame changed it a last time for today :) (i'll leave the last formating up to you) have fun :) — Dirk Reichel, Nov 23 '15 at 17:58
oh... looking for the numbers you need to use `noFind(i, 1)`... it has the exact same values like your listbox (but having at `noFind(*, 4)` the nuber if lines copied) — Dirk Reichel, Nov 23 '15 at 18:05
Hi this is still not quite what im after, i have changed the image in the OP if you can have a look, i quickly made a userform to demostrate how i want the msgbox to display and what info is needed in it. Thanks — atame, Nov 24 '15 at 17:52
sorry... but that is only something like formating... `nofind` includes all values you may need... as said, it holds the same values as your listbox does, but having at `noFind(*, 4)` the number of lines copied for the selected entry... how you want it to look, is up to you... and i don't think its part of the question... if you need help doing it, please ask a new question — Dirk Reichel, Nov 24 '15 at 18:17

MGP · Answer 2 · 2015-11-20T15:55:22.643

0

You could try something like this. The Range.Find-Method basically looks through the given range for a value which you can specify. If a match is found, the cell in which the match is found, can then be stored.

You can then also use .FindNext to find the next occurrence of that value, if needed.

For j = 0 To Me.ComboBox2.ListCount - 1

        currval = Me.ComboBox2.List(j, 0) ' value to match

        Set rngCPY = sheets("Global").Range("Q:Q").Find(currval, LookIn:=xlValues)

        Do While Not rngCPY Is Nothing

            strWs = Me.ComboBox2.List(j, 1)

            rngCPY.EntireRow.Copy

            With Worksheets(strWS)
                .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown
            End With

            Set rngCPY = sheets("Global").Range("Q:Q").FindNext(rngCPY)

        Loop

Next j

edited Nov 20 '15 at 15:55

answered Nov 20 '15 at 13:35

MGP

2,480
1
18
31

1

Just so you can improve this a bit (please indent code) : http://stackoverflow.com/questions/30161124/vba-find-and-adding-a-value/30162390#30162390 – R3uK Nov 20 '15 at 13:44
You are right. Should post like I would want others to post code! – MGP Nov 20 '15 at 13:48
@MarcoGetrost. I didnt get a error, it just did nothing. Would i be helpful if i uploaded the workbook? – atame Nov 20 '15 at 14:03
@atame I made an Edit to the code. Please try again. – MGP Nov 20 '15 at 14:12
@MarcoGetrost. Hi, it needs to be insert shift down, as the data needs to be paste after a certain range, and there are rows below that need to stay where they are. thanks – atame Nov 20 '15 at 14:17
@atame Is there a certain criteria at which row it needs to be copied to? Since what you did, the `.Cells(Rows.Count,1).End(xlUp).Offset(1,0)` will find the last row... – MGP Nov 20 '15 at 14:21
@MarcoGetrost. Yes the row needs to be copied a specific sheet, which is picked up from the combobox in column1. this is the inserted in that sheet after the last used row. as the action will be performed every month. After the last row there is a blank row, then 3 rows of data that sum certain columns, with other formulas. – atame Nov 20 '15 at 14:24
@atame I made a edit, please try again, the `.Offset(-3,0)` should point to the blank row, in which the new row is then inserted! – MGP Nov 20 '15 at 14:32
@MarcoGetrost. the other thing i have only just noticed, is that the sheet name is not being picked up from anywhere? it comes from me.combobox2.list(j,1) – atame Nov 20 '15 at 14:34
@atame sorry, I must have missed that, I have now added it. – MGP Nov 20 '15 at 14:36
@MarcoGetrost. it worked but only copied the first instance of the of the matching value. I had to add a couple of things, will edit you post with the corrections. – atame Nov 20 '15 at 14:44
Good, that it worked. I said at the beginning of my post that `.FindNext` will find the next instance. usually wrapped in a `Do ... Until` Loop. – MGP Nov 20 '15 at 15:00
@MarcoGetrost. sorry i missed that, where would i place that in the code? thanks – atame Nov 20 '15 at 15:03
@atame Look at the edit, it could look something like that. – MGP Nov 20 '15 at 15:28
@MarcoGetrost. it loops, but gets suck in the loop, it keeps pasting the first row over and over, it seems to get stuck on the end with. – atame Nov 20 '15 at 15:51
on which line? I currrently don't have access to excel so I'm just typing this as it comes to my head. – MGP Nov 20 '15 at 15:53
@atame Ok I think I found it. Please see the edited version – MGP Nov 20 '15 at 15:55
@MarcoGetrost. it now loops through all the rows, but instead of moving to the next sheet it keeps looping over and copies the same data over and over. – atame Nov 20 '15 at 15:56
@marco, i have managed to get a bit of code using your base, to partially work, it copies the info to the correct sheets, and works properly if the sheets do not already exist and have to be create, the problem lies if the sheet already exists, if gives and error, Run-time error '381': could not get the list property. Invalid property array index. thanks – atame Nov 23 '15 at 09:09
@MarcoGetrost. I have updated my OP with the new version on Option 2. It breaks at Dim CCName As Variant: CCName = UserForm2.ComboBox2.List(j, 2). in the bm_Need_Worksheet. – atame Nov 23 '15 at 09:12

score 0 · Answer 3 · edited Apr 13 '17 at 12:40

0

Here is a small section of your code that replace the loop through each cell in Global!Q3:Q*<last_row>* with the VBA version of the MATCH function.

Dim rw As Long, rngGQs As Range   '<~~ put this closer to the top with the other variable declarations

' find last row
'lastG = Sheets("Global").Cells(Rows.Count, "Q").End(xlUp).Row '<~~old way

With Sheets("Global") '<~~new way
    Set rngGQs = .Range(Cells(3, "Q"), .Cells(Rows.Count, "Q").End(xlUp)) '< ~~ all of the cells to look at
End With

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 '<~~old way
                'lookupVal = Sheets("Global").Cells(i, "Q") ' value to find
                'If lookupVal = currval Then
            If Not IsError(Application.Match(currval, rngGQs, 0)) Then '<~~new way
                rw = Application.Match(currval, rngGQs, 0)
                Set rngCPY = Sheets("Global").Cells(rw, "Q").EntireRow

                'all the rest here

When you get this to a satisfactory working order, it will be a prime candidate for suggestions at Code Review (Excel).

edited Apr 13 '17 at 12:40

Community

1
1

answered Nov 20 '15 at 13:45

This did not work im afraid, would i be helpful, if i were to upload the workbook? – atame Nov 20 '15 at 13:56
Wouldn't `MATCH` just do it for the first match? If I got his code correct, he wants it for each match... which would make `MATCH` as good as useless here... Just having a `Exit For` in his `If lookupVal = currval Then` should be enough... however having the `New worksheet`-part in an own sub may speed it up a bit (or at least it will be easier to understand)... but not sure if any of it can speed it up... – Dirk Reichel Nov 20 '15 at 14:42
@DirkReichel. Thanks for the post. could you possible edit my original code to show how you think it should go, i can then give it a test and let you know. thank you – atame Nov 20 '15 at 14:47
@atame unfortunally i'm not at home right now... maybe in 3h... you may got all answers till then allready... – Dirk Reichel Nov 20 '15 at 14:49
@DirkReichel. If you could have a look when you get home i would really appreciate it!! Thanks – atame Nov 20 '15 at 14:51
@atame - Could you confirm one way or another if you are looking for multiple matches or just the first one? Additionally (friendly advice) statements like *"This did not work"* do not go very far in explaining a problem. – Nov 20 '15 at 15:04
@Jeeped. I am looking for multiple matches. Apologizes, i will explain myself further next time. thanks – atame Nov 20 '15 at 15:05
@atame - In the case of multiple matches, dump the values from column Q into a variant memory array or scripting dictionary and use that for comparison. The repeated looping through column Q cell-by-cell is the slowest method of value comparison possible. – Nov 20 '15 at 15:12
@Jeeped. How would i code that because that has completely confused me!! – atame Nov 20 '15 at 15:16

Match cell value to a combobox row value

3 Answers3