VBA - update find function to loop through rows and move on if value isn't there

Question

Trying to put together a macro that searches each row to see if it contains 7 search terms (see "Warranty:" example below). If the cell starts with one of the phrases (like "Warranty:"), then that cell is pasted in a specific cell (same row but different column) in another worksheet.

Issues:

Had trouble with the macro until I added the select function - I know this slows them down, but I couldn't figure out a way to do this without it
Can't figure out how to get it to loop through all rows

Errors if the row doesn't have the word - need it to just keep going through

Sub FindTest()

 Worksheets("Macro").Range("1:1").Find(What:="Warranty: ", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True).Copy
'Cell begins with "Warranty:" but text following varies

Sheets("CSV Upload").Select
Sheets("CSV Upload").Range("J1").Select
ActiveSheet.Paste

End Sub

UPDATE:

Sub FindTest()

Dim Macro As Worksheet: Set Macro = Sheets("Macro")
Dim CSV As Worksheet: Set CSV = Sheets("CSV Upload")

'On Error Resume Next
For R = 1 To Macro.UsedRange.Rows.Count
    Set rng = Macro.Rows(R)

Dim FindRange As Range: Set FindRange = rng.Find(What:="Warranty:", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)

'FindRange.Copy CSV.Range("J1")
'CSV.Cells(1, J) = Macro.Cells(FindRange)

Next

'On Error GoTo 0

End Sub

Are you looking in a specific column, or can the cell with "Warranty" be in any column? — Cohan, Nov 01 '18 at 18:45
What have you tried? Searching "vba loop through rows" returns too many pages to count. Also, please [don't use `.Select`/`.Activate`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). It may solve the issue now, but will likely lead to more headaches later. Third, I'd put the `...Find()` in a Range variable. Then check if that's `Nothing` before proceeding. E.g. `Dim fndRng as Range // Set fndRng = Worksheets().Range().Find(...) // if Not fndRng is Nothing Then ...` — BruceWayne, Nov 01 '18 at 18:46
Up to now I've only edited existing macros or recorded them, so @BrianCohan thank you for the explanation on everything! I *think* I'm having a syntax problem telling the macro where to paste the found value. The destination row will be the same as the original row, but the destination/original columns will be different and varied. Everything seems to be working fine until I get to the paste function. I've tried - FindRange.Copy CSV.Range("J1") - and - CSV.Cells(1, J) = Macro.Cells(FindRange) - Also, do you have any suggestions how to make the paste function continue? — MWalker, Nov 02 '18 at 15:41
@BruceWayne Yea, I'm relatively new to VBA so do try to heed the general advice out there and avoid select and activate. Thanks for your help. Posted the update to code. Having trouble with pasting and getting the function to paste in all rows. — MWalker, Nov 02 '18 at 15:48
@MWalker I had similar problems when I was trying to find out some product id that was repeating on multiple lines below. The problem I had is when first match was found them the code will not resume the same criteria and search again until it either finds another match or the list finishes. I have found a way to solve this but can’t really remember on top of my head. I will have a look through my projects and will get back to you but have a look into this example. `Set FindMatch = Rng.Find(What:=“Warranty:”, After:=rng.Cells(1,1), LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)` — QuickSilver, Nov 02 '18 at 16:37
@MWalker, I updated my answer based on your new information. Let me know if there's anything else that you can't figure out. If you found it useful, please upvote and or accept the answer so others know you found a solution. — Cohan, Nov 02 '18 at 16:44

Cohan · Accepted Answer · 2018-11-02T17:23:05.080

To loop through each row in the worksheet:

Dim ws As Worksheet: Set ws = Sheets("Macro")
Dim csv_upload As workseet: Set csv_upload = Sheets("CSV Upload")

For r = 1 To ws.UsedRange.Rows.Count
    Set rng = ws.Rows(r)
    rng.Find(What:="Warranty: ", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)

    ...
Next

Then to copy the values, depending on which cells you need to copy

csv_upload.cells(dest_row, dest_col) = ws.cells(orig_row, orig_col)

For it to continue when you have an error, you can tell it to resume

On Error Resume Next
' potential for error to be raised
' Don't use this unless you know you are going to get a specific
' error and know there are no unintended consequences of ignoring it.
On Error GoTo 0

Using the code in your update, the following code should work for you.

Sub FindWarranty()

    Dim Macro As Worksheet: Set Macro = Sheets("Macro")
    Dim CSV As Worksheet: Set CSV = Sheets("CSV Upload")
    Dim rng As Range, FindRange As Range
    Dim Phrase As String

    Phrase = "Warranty:"

    For r = 1 To Macro.UsedRange.Rows.Count

        Set rng = Macro.Rows(r)
        Set FindRange = rng.Find(What:=Phrase, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)

        If Not FindRange Is Nothing Then
            ' Set destination cell to what you need it to be
            c = 1
            CSV.Cells(r, c) = FindRange
        End If

    Next

End Sub

A slightly more elegant way that Quicksilver alluded to is:

Sub FindWarrantys()

    Dim Macro As Worksheet: Set Macro = Sheets("Macro")
    Dim CSV As Worksheet: Set CSV = Sheets("CSV Upload")
    Dim FoundCell As Range, FirstAddr As String
    Dim Phrase As String, c As Integer

    Phrase = "Warranty:"

    ' Find the first occurrence. The after variable is set to the
    ' last cell so that it will start searching from the beginning.
    Set FoundCell = Macro.UsedRange.Find(what:=Phrase, _
        after:=Macro.UsedRange.Cells(Macro.UsedRange.Cells.Count))

    ' Save the address of the first occurrence to prevent an infinite loop
    If Not FoundCell Is Nothing Then
        FirstAddr = FoundCell.Address
    End If

    ' Loop through all finds
    Do Until FoundCell Is Nothing

        c = 1 ' Adjust for logic to determine which column
        CSV.Cells(FoundCell.Row, c) = FoundCell

        ' Find the next occurrence
        Set FoundCell = Macro.UsedRange.FindNext(after:=FoundCell)

        ' Break if we're back at the first address
        If FoundCell.Address = FirstAddr Then
            Exit Do
        End If

    Loop

End Sub

I recommend against the broad `On Error Resume Next`, unless OP expects a specific error. Otherwise, it might hide errors that OP should fix, and return incorrect/false data, etc. — BruceWayne, Nov 02 '18 at 16:32
I agree, it should only be used surrounding an area where a specific error is expected. — Cohan, Nov 02 '18 at 16:33
@BrianCohan this is actually close to what I have done in the past but there is a way to make it continue to search all the data I’m not at a computer now but in the find there is an option called After that can be set and it will continue till the whole list is finished. Don’t know if there is a point to loop. Just declare the range you are looking to search and put After and use if statements with labels to jump back and forward in code therefore search the whole list. When I’ll get to a computer I’ll post the way I did it. — QuickSilver, Nov 02 '18 at 16:53
@BrianCohan Nice one yes more elegant this one guess there is no point to post same thing as the answer is given above by you well done. — QuickSilver, Nov 02 '18 at 21:27
@BrianCohan Thank you so much for all of your help! Both of these macros work perfectly. — MWalker, Nov 06 '18 at 19:29

VBA - update find function to loop through rows and move on if value isn't there

1 Answers1