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-17T06:31:22.520

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 '20 at 06:31

answered Mar 17 '20 at 05:17

Tim Williams

154,628
8
97
125

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: https://stackoverflow.com/questions/60770362/if-and-loop-function . – nicole hi Mar 20 '20 at 07:54
Looks like you already have a good answer there. No need for loops when you have built-in functions which already do this quickly. – Tim Williams Mar 20 '20 at 15:46

score 0 · Answer 2 · answered Mar 17 '20 at 06:45

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 '20 at 06:45

Jacob

33
4

If and Loop function to extract data

2 Answers2

Linked