If and Loop function to extract data

Question

In the sample dataset above, I am trying to use the VBA's If function to look for a specific keyword, and if there's a match, I would want to extract the Name itself, alongside its Serial Number and Product, and add to the last row of another worksheet, within the same workbook.

For instance, If in column C, we detect, say, cana (note that this is not an exact match, but good enough), then I would want VBA to help me to extract Canary Wharf, its Serial Number and Product next to it, which are 8273615 and Canned Food, to the end of another worksheet, and the loop goes on until the end of Canary Wharf and moves on to Riverdale, which I would type, say, riverd, and repeat the same process. The x's are there to signify that I have a rather large dataset, nothing else.

I have gotten some clues with the top answer found in Using "If cell contains" in VBA excel , it is of great help, but I could not quite get the exact thing to do. Any help would be very much appreciated!

Below should be the intuition:

Option Compare Text

Sub DataExtraction()

Dim SrchRng As Range, cel As Range
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")


Set SrchRng = ws1.Range("C:C")

For Each cel In SrchRng
    If InStr(1, cel.Value, "cana") > 0 Then
        ActiveCell.Value = "Canary Wharf"

    End If
Next cel

End Sub

By using the code above, I managed to get the ActiveCell.Value to become Canary Wharf, however, I need the code to loop until there are no more Canary Wharf's, and at the same time, also copy the two inputs to its right.

Tim Williams · Accepted Answer · 2020-03-17 06:31:22Z

0

You can do something like this:

Option Compare Text

Sub DataExtraction()

    Dim SrchRng As Range, cel As Range, rngDest as Range
    Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    'restrict the search range
    Set SrchRng = Application.Intersect(ws1.Range("C:C"), ws.UsedRange)

    Set rngDest = ws2.cells(rows.count, 1).end(xlUp).Offset(1, 0) 'start copy here

    For Each cel In SrchRng.Cells
        If InStr(1, cel.Value, "cana") > 0 Then
            rngDest.Value = "Canary Wharf"
            rngDest.offset(0, 1).value = cel.offset(0, 1).value
            rngDest.offset(0, 2).value = cel.offset(0, 2).value
            Set rngDest = rngDest.offset(1, 0) '<< next row down
        End If
    Next cel

End Sub

edited Mar 17, 2020 at 6:31

answered Mar 17, 2020 at 5:17

Tim Williams

169k8 gold badges104 silver badges143 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

nicole hi Over a year ago

Tim, I cannot thank you enough for your contribution. If it is not too much to ask, could I draw your expertise on a similar question posted here as well: stackoverflow.com/questions/60770362/if-and-loop-function .

Tim Williams Over a year ago

Looks like you already have a good answer there. No need for loops when you have built-in functions which already do this quickly.

Jacob · Accepted Answer · 2020-03-17 06:45:09Z

0

You may want to use a userform to input what you wanna find and use range.find

Dim C as Integer

C = Range("C:C").Find(Userform1.Value).Row

answered Mar 17, 2020 at 6:45

Jacob

334 bronze badges

Collectives™ on Stack Overflow

If and Loop function to extract data

2 Answers 2

2 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

2 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related