CODEWITHSUNDEEP
excelvba
nicole hi
nicole hi

Reputation: 13

If and Loop function to extract data

Sample Dataset

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.

Upvotes: 1

Views: 92

Answers (2)

Jacob
Jacob

Reputation: 33

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

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166341

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

Upvotes: 0

Related Questions