Excel VBA: For loop with Match function, OnError works if no match is found, but inserts empty row

Question

I have a loop set up with a match function, so it checks if there is a match and then returns the result and repeats this for a defined number of times. I also have it set up so if there is an error, meaning if there is no match, it skips to the next loop. However, when no match is found, it leaves an empty row before inputting the next match below it. That's what I'm trying to avoid.

The way my code currently works is like this:

ws1 has multiple columns and rows of data. The first cell on every row in column A is the title. The titles are from a fixed selection (it's a drop down) which are determined by a list that is on ws2

ws2 has the list of titles, which is h3 until LastRow

ws3 Upon button click, it will match any results that correlate with variable_condition, and if it can't find a match it will go to the next loop, then print it on multiple rows from row 4 onwards

On ws3 it also inserts a shape which is assigned a macro (and thus becomes a button) on each row

What actually happens is, if it can't find a match, an empty row appears with this shape in column I.

I'm trying to make it so there isn't a blank row with a button and instead it just inserts the next looped result

My code below:

Sub CardsCollection()

Set ws1 = Sheets("Database")
Set ws2 = Sheets("Insert")
Set ws3 = Sheets("Sheet1")

Dim myCell As Range
Dim LastRow As Long

LastRow = ws2.Cells(ws2.Rows.Count, "H").End(xlUp).Row
Debug.Print LastRow

Dim test_string As String
test_string = "H" & LastRow
Dim test_range As Range
Set test_range = ws2.Range(test_string)

variable_condition = Range("E2")

NxtRw = 4

On Error Resume Next
For Each myCell In ws2.Range("H3" & ":" & test_string)
    row_num2 = Evaluate("MATCH(1,('" & ws1.Name & "'!A:A=""" & myCell & """)*('" & ws1.Name & "'!F:F=""" & variable_condition & """),0)")
    ws3.Range("A" & NxtRw).EntireRow.Value = ws1.Range("A" & row_num2).EntireRow.Value


Dim button_cell As String
    button_cell = "I" & NxtRw

    Dim bc_range As Range
    Set bc_range = Range(button_cell)

    Dim rect1 As Shape
    Dim rngToCheck As Range
    Dim clLeft As Double
    Dim clTop As Double
    Dim clWidth As Double
    Dim clHeight As Double

    Dim shpRec As Shape
    Set cl = Range(button_cell)

    With shpRec
        clLeft = cl.Left
        clTop = cl.Top
        clWidth = cl.Width - 5
        clHeight = cl.Height - 5
    End With


    Set shpRec = ActiveSheet.Shapes.AddShape(msoShapeRectangle, clLeft, clTop, clWidth, clHeight)


        With shpRec
        .Fill.ForeColor.RGB = RGB(242, 177, 135)
        .Line.Visible = False 'True
        .Line.ForeColor.RGB = RGB(255, 255, 255)
        .TextFrame.Characters.Text = "INSERT"
        .TextFrame.HorizontalAlignment = xlHAlignCenter
        .TextFrame.VerticalAlignment = xlVAlignCenter
        .TextFrame.Characters.Font.Size = 24
        .TextFrame.Characters.Font.Name = "SF Pro Display Black"
    End With

    NxtRw = NxtRw + 1
Next

End Sub

Any help would be appreciated! Thanks

EDIT: Updated code

Sub CardsCollection()

Call last_used_sort


Set ws1 = Sheets("Database")
Set ws2 = Sheets("Insert")
Set ws3 = Sheets("Sheet1")

Dim myCell As Range
Dim LastRow As Long

LastRow = ws2.Cells(ws2.Rows.Count, "H").End(xlUp).Row
Debug.Print LastRow

Dim test_string As String
test_string = "H" & LastRow
Dim test_range As Range
Set test_range = ws2.Range(test_string)

Dim row_num2 As Long

variable_condition = Range("E2")


NxtRw = 4


For Each myCell In ws2.Range("H3" & ":" & test_string)
    row_num2 = -1
    On Error Resume Next
    row_num2 = Evaluate("MATCH(1,('" & ws1.Name & "'!A:A=""" & myCell & """)*('" & ws1.Name & "'!F:F=""" & variable_condition & """),0)")
    On Error GoTo 0
    If row_num2 <> -1 Then
    ws3.Range("A" & NxtRw).EntireRow.Value = ws1.Range("A" & row_num2).EntireRow.Value

    Dim button_cell As String
    button_cell = "I" & NxtRw


    Dim bc_range As Range
    Set bc_range = Range(button_cell)


    Dim rect1 As Shape
    Dim rngToCheck As Range
    Dim clLeft As Double
    Dim clTop As Double
    Dim clWidth As Double
    Dim clHeight As Double

    Dim shpRec As Shape
    Set cl = Range(button_cell)

    Dim button_cell As String
    button_cell = "I" & NxtRw


    Dim bc_range As Range
    Set bc_range = Range(button_cell)


    Dim rect1 As Shape
    Dim rngToCheck As Range
    Dim clLeft As Double
    Dim clTop As Double
    Dim clWidth As Double
    Dim clHeight As Double

    Dim shpRec As Shape
    Set cl = Range(button_cell)

    Set shpRec = ActiveSheet.Shapes.AddShape(msoShapeRectangle, clLeft, clTop, clWidth, clHeight)


        With shpRec
        .Fill.ForeColor.RGB = RGB(242, 177, 135)
        .Line.Visible = False 'True
        .Line.ForeColor.RGB = RGB(255, 255, 255)
        .TextFrame.Characters.Text = "INSERT"
        .TextFrame.HorizontalAlignment = xlHAlignCenter
        .TextFrame.VerticalAlignment = xlVAlignCenter
        .TextFrame.Characters.Font.Size = 24
        .TextFrame.Characters.Font.Name = "SF Pro Display Black"
    End With


    NxtRw = NxtRw + 1

End If
Next

End Sub

So basically if `rownum2` is nothing then the code should just skip to the next iteration without performing anything further ? — Mikku, Aug 12 '19 at 09:18
Skip to the next iteration and not produce an empty row as a result of finding nothing - yep — Sam, Aug 12 '19 at 09:19
On error resume next will just skip the line with the error, not the entire loop. You would want something like: `On Error GoTo NextLoop` and place `NextLoop:` on the row before `Next` — Luuklag, Aug 12 '19 at 09:22
Try Changing `NxtRw = NxtRw + 1` with `If IsNumeric(row_num2) Then NxtRw = NxtRw + 1`. — Mikku, Aug 12 '19 at 09:24
@Mikku, that will still insert the shape, but then you will get two shapes on top of each other, making more of a mess. — Luuklag, Aug 12 '19 at 09:25
@Sam I see you just edited your code, please leave the question be as the question was, since now it is no longer a question. I just finished writing up an answer. — Luuklag, Aug 12 '19 at 09:34

score 3 · Accepted Answer · answered Aug 12 '19 at 10:14

3

The correct solution is to isolate the source of potential error and handle it. I see several options here

Using your Evaluate code

For Each myCell In ws2.Range("H3" & ":" & test_string)
    row_num2 = -1
    On Error Resume Next
        row_num2 = Evaluate( ... )
    On Error GoTo 0
    If row_num2 <> -1 Then

        '...
        ' rest of your loop code

    End If
Next

Using a more conventional WorksheetFunction approach, which will also throw a runtime error if a match is not found

For Each myCell In ws2.Range("H3" & ":" & test_string)
    row_num2 = -1
    On Error Resume Next
        row_num2 = Application.WorksheetFunction.MATCH( ... )
    On Error GoTo 0
    If row_num2 <> -1 Then

        '...
        ' rest of your loop code

    End If
Next

Using Application.Match which will not throw a runtime error, but retrn a error value instead

Dim row_num2 As Variant
For Each myCell In ws2.Range("H3" & ":" & test_string)
    row_num2 = Application.MATCH( ... )

    If Not IsError(row_num2) Then

        '...
        ' rest of your loop code

    End If
Next

Note: I don't fully understand your Match formula, so haven't tried to translate to the Match function version.

answered Aug 12 '19 at 10:14

chris neilsen

52,446
10
84
123

I'll test this out with my spreadsheet in a couple of minutes and report back how it went. Thanks for your help! Do you have any insights into my comment earlier? I'll paste it here: Do you know of a way to use Match to find a different result than the one already produced? For example, you see how my code inserts a button? If I amended the code to insert a different button called 'refresh', is it possible to make it so if the user clicks this button it will replace that row with a different match? Different to the one already written to the row – Sam Aug 12 '19 at 10:19
@sam broadly, sure that possible. (But I don't see where you assign an action to the button you insert now?) You can use `Application.Caller` to shape that called a macro, and use the shape position to betermine the row to update – chris neilsen Aug 12 '19 at 10:29
Nice write up Chris. @Sam could also be usefull to read this Q https://stackoverflow.com/questions/6028288/properly-handling-errors-in-vba-excel – Luuklag Aug 12 '19 at 10:31
Ah I didn't realise I hadn't updated the code with the Call subroutine(). I don't have a problem getting the buttons to be assigned with a macro, but the bit I can't get my head around is telling the match to look for a different match other than the one that's already been written into the row EDIT: for example, I thought about an if statement, if row x is the same as match value then match again. But match will just return the same value each time, right? Is there a way to tell match to go to the next result – Sam Aug 12 '19 at 10:34
@sam still using Match, I think the only option would be to change the serch range to start after the last found cell. – chris neilsen Aug 12 '19 at 10:37
So I would get the match to return the row number like it is now, then the refresh match would change from A:A for example to A row number to A1000 for example? EDIT: or, for neatness, rather than A1000 I could just do LastRow – Sam Aug 12 '19 at 10:40
I'll give that a go when I try your code and ill let you know how it goes - thanks for your help – Sam Aug 12 '19 at 10:49
@Sam please keep in mind that you can at any time change the answer you "accept". So if you found this answer more usefull then mine, click on the green tick at my answer to remove it and assign it any were else if you see fit. – Luuklag Aug 12 '19 at 11:04
@Luuklag Thanks for letting me know, once I've implemented the other code I'll correct it if needs be - thanks – Sam Aug 12 '19 at 11:07
So I've tried to implement the first option, using Evaluate, and I'm getting a Type Mismatch error indicating that it didn't find a match and has stopped proceeding to the next loop - any ideas? – Sam Aug 12 '19 at 11:28
@Sam Something I didn't notice before: you havn't DIM'd row_num2 in your posted code. Have you in your actual code? – chris neilsen Aug 12 '19 at 11:37
@Sam In testing just now, if row_num2 is a variant, there is no runtime error (returns an error value). If row_num2 is a (say) Long then there is an error and On Error Resume Next masks it. So, you can't have implemengted the code as I posted it. Maybe update your Q with latest code – chris neilsen Aug 12 '19 at 11:39
I've updated the original post with my code. I included the dim row_num2 As Variant at the top. Maybe it's my placement of the End If? – Sam Aug 12 '19 at 11:43
@sam perhaps I wasn't clear: you need to remove `On Error Goto NextLoop` and `NextLoop:`. Alos,since you are DIM'g row_num2 as Variant, a structure along the lines of my option 3 would be more appropriate (still using Evaluate). If you still get an error it won't be on the Evaluate line. Report back on which line it is on – chris neilsen Aug 12 '19 at 11:49
I've updated my original post's edit (the 2nd block of code) with your advice and it works now! Thanks! I'm going to try and attempt the refresh subroutine now – Sam Aug 12 '19 at 12:26
@chrisneilsen I'm having trouble writing my match using variables as the range instead of directly writing it like I did before (eg. A:A) `row_num3 = Evaluate("MATCH(1,('" & ws1.Name & "'found_match=""" & condition1 & """)*('" & ws1.Name & "'found_match2=""" & condition2 & """)*('" & ws1.Name & "'condition3=""" & flow_cell & """),0)")` I've got found_match set up to be `found_match = "A" & row_num2 & ":A" & lastrow3` for example – Sam Aug 12 '19 at 14:33

score 1 · Answer 2 · answered Aug 12 '19 at 09:34

1

First off, using On Error Resume Next is one of the worst lines of code one could write in VBA, since it only hides errors. It doesn't show you what is wrong with your code, or perhaps your assumption in your code are wrong. So you really should avoid using this at all. If your code relies on a line like this to function it should really be improved.

Now for a quick fix on your code, you want it to be the case that if no match is found, you resort to the next iteration. As your comparison statement is rather hard to read without sample data I'll do you the quick fix below:

So change your On Error Resume Next part in the code like this:

NxtRw = 4

On Error GoTo NextLoop
For Each myCell In ws2.Range("H3" & ":" & test_string)
    row_num2 = Evaluate("MATCH(1,('" & ws1.Name & "'!A:A=""" & myCell & """)*('" & ws1.Name & "'!F:F=""" & variable_condition & """),0)")
    ws3.Range("A" & NxtRw).EntireRow.Value = ws1.Range("A" & row_num2).EntireRow.Value

And indicate where the code should continue like this:

    NxtRw = NxtRw + 1
NextLoop: 'this indicates where to continue
Next

End Sub

It would be better to check if a match could be possible with an If statement, so you could simply rely on that logic to skip to the end of the loop.

answered Aug 12 '19 at 09:34

Luuklag

3,897
11
38
57

Works perfectly, thanks! While I'm here, do you know of a way to use Match to find a different result than the one already produced? For example, you see how my code inserts a button? If I amended the code to insert a different button called 'refresh', is it possible to make it so if the user clicks this button it will replace that row with a different match? Different to the one already written to the row – Sam Aug 12 '19 at 09:43
2

This is actually terrible advise. It's just as bad as an unconstrained On Error Resume Next. What if a different error occurs half way through the rest of the loop code? It will jump to the next iteration of the loop, leaving whatever was half done, still half done. The correct why is to use a `On Error Resume Next` tightly bound with a `On Error Goto 0` around the code that might error, followed by a test to see if the code worked, then conditionally execute the rest of the loop code. – chris neilsen Aug 12 '19 at 09:53
@chrisneilsen are you able to write an example in context like the others? I think I understand your concept but unsure exactly the positioning of where it should go – Sam Aug 12 '19 at 09:55
@chrisneilsen ofcourse this isnt the best solution, but a quick fix. As I did indicate in my answer. – Luuklag Aug 12 '19 at 10:07
@Sam As an example, the `WorksheetFunction.Match` function returns an error if the value cannot be found. Hence `var = 0: On Error Resume Next: var = WorksheetFunction.Match("Value", Sheet1.Range("A1:A7"),0): On Error GoTo 0` will set `var` to the row that `"Value"` is found on, unless it isn't in the range `A1:A7`, in which case `var` will be 0. `If var>0 Then` can later be used to prevent errors. – Chronocidal Aug 12 '19 at 10:29

Excel VBA: For loop with Match function, OnError works if no match is found, but inserts empty row

2 Answers2