Find multiple values(VBA)

[Craig__]

Hi guys

I use the macro below to find the first occurrence of three words. Is there a VBA expert who could modify the code so that it finds all occurrences of three words?

I would be so grateful for your help.


Sub Find_Multiple_Values()

Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim WhatToFind As Variant
Dim iCtr As Long
Dim DestCell As Range

Set wks = ActiveSheet
Set rngToSearch = wks.Columns(5)

WhatToFind = Array("Weekly", "Monthly", "Annually")

For iCtr = LBound(WhatToFind) To UBound(WhatToFind)
With rngToSearch
Set rngFound = .Cells.Find(What:=WhatToFind(iCtr), _
LookIn:=xlValues, LookAt:=xlWhole, _
After:=.Cells(.Cells.Count), _
MatchCase:=False)

If Not rngFound Is Nothing Then
MsgBox rngFound
End If
End With
Next

End Sub

 

[circledchicken]

Hi,

You could use a second loop with the CountIf function as follows:

Option Explicit

Sub Find_Multiple_Values()

Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim WhatToFind As Variant
Dim iCtr As Long
Dim DestCell As Range
Dim iLoop As Long

Set wks = ActiveSheet
Set rngToSearch = wks.Columns(5)

WhatToFind = Array("Weekly", "Monthly", "Annually")

With rngToSearch
    For iCtr = LBound(WhatToFind) To UBound(WhatToFind)
        Set rngFound = .Cells(.Cells.Count)
            For iLoop = 1 To WorksheetFunction.CountIf(rngToSearch, WhatToFind(iCtr)) ' second loop
                    Set rngFound = .Cells.Find(What:=WhatToFind(iCtr), _
                    LookIn:=xlValues, LookAt:=xlWhole, _
                    After:=rngFound, _
                    MatchCase:=False)
            If Not rngFound Is Nothing Then
                MsgBox rngFound
            End If
        Next iLoop
    Next
End With

End Sub

See here for more information - http://www.ozgrid.com/VBA/VBALoops.htm

 

[Craig__]

Many thanks for your help CircledChicken, you are a genius. Your solution works perfectly.

Craig

 

[circledchicken]

Your welcome!

 

[nunnakc]

All, I am new to VBA and learning it as I am working with it. I modified the above code to use it for a project that I am working on. The project goal is to copy data from one worksheet and paste it in another worksheet. The data to be copied is based on finding the text "Step#:" in column 2. So far I got the code to copy and paste the data in sheet2. There are 30 steps. However, I have two issues. The copied data is getting pasted in Sheet2 A1:A30 is the same. Each paste (data copied from each instance of "Step#:" is paste over the previous pasted values. What I need assistance is to alter the code such that, each instance of "Step#:" found, the data from is copied and pasted in one individual row. The next instance of "Step#:", paste the next row. Any help is much appreciated.

Sub FindStep()
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim WhatToFind As Variant
Dim iCtr As Long
Dim DestCell As Range
Dim iLoop As Long
Set wks = Worksheets("Sheet1")
Set rngToSearch = wks.Columns(2)
WhatToFind = Array("Step#:")
With rngToSearch
    For iCtr = LBound(WhatToFind) To UBound(WhatToFind)
        Set rngFound = .Cells(.Cells.Count)
            For iLoop = 1 To WorksheetFunction.CountIf(rngToSearch, WhatToFind(iCtr)) ' second loop
                    Set rngFound = .Cells.Find(What:=WhatToFind(iCtr), LookIn:=xlValues, LookAt:=xlWhole, _
                    After:=rngFound, MatchCase:=False)
                    
                    rngFound.Cells.Offset(1, 0).Copy Destination:=Worksheets("Sheet2").Range("A1:A30")
                    rngFound.Cells.Offset(2, 1).Copy Destination:=Worksheets("Sheet2").Range("B1:B30")
                    
           Next iLoop
              Next
           
    
End With
End Sub

 

[Craig__]

Hi Nunnakc

Can you attach a spreadsheet example showing:
1) What your data looks like "before" the code is run.
2) How you want the data to look "after" the code is run.

Cheers -
Craig

 

[circledchicken]

Hi nunnakc and welcome to the forum,

As Craig mentioned it might be easier if you post a small example, but here is a guess based on what you provided:

Sub FindStep()


    Dim strFind     As String
    Dim oRng        As Range
    Dim fRng        As Range
    Dim i           As Long


    strFind = "Step#:" ' string to find
    Set oRng = Worksheets("Sheet1").Columns(2) ' column to search
    
    Set fRng = oRng.Cells(oRng.Cells.Count)
    For i = 1 To Application.CountIf(oRng, strFind & "*")
        Set fRng = oRng.Cells.Find(What:=strFind, _
                                   LookIn:=xlValues, _
                                   LookAt:=xlPart, _
                                   After:=fRng, _
                                   MatchCase:=False)
        If Not fRng Is Nothing Then
            With Worksheets("Sheet2")
                .Cells(i, "A") = fRng.Offset(1, 0).Value2
                .Cells(i, "B") = fRng.Offset(2, 1).Value2
            End With
        End If
    Next i


End Sub

 

[nunnakc]

Awesome...it works like a charm. Amazing. Thanks so much circledchicken. Thanks Craig for the question. I will post examples next time I run into a road block.

 

[circledchicken]

You're welcome and thanks for the feedback.

 

[mylday]

Hi,
Please help.
i have a worksheet with many quotations and relevant database. I am trying to figure out a way to look in to this worksheet ( sheet 1) with some of of the multiple values in sheet 3 column A and reply me with it is occurrence ( multiple) in sheet 1 with its relevant data in sheet 2.
I tired to run a macro as below.

Sub GeneFinder()
Dim srchLen, gName, nxtRw As Integer
Dim g As Range
'Clear Sheet 2 and Copy Column Headings
Sheets(2).Cells.ClearContents
Sheets(1).Rows(1).Copy Destination:=Sheets(2).Rows(1)
'Determine length of Search Column from Sheet3
srchLen = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row
'Loop through list in Sheet3, Column A. As each value is
'found in Sheet1, Column G, copy it top the next row in Sheet2
With Sheets(1).Columns("G")
For gName = 2 To srchLen
Set g = .Find(Sheets(3).Range("A" & gName), lookat:=xlPart)
If Not g Is Nothing Then
nxtRw = Sheets(2).Range("G" & Rows.Count).End(xlUp).Row + 1
g.EntireRow.Copy Destination:=Sheets(2).Range("A" & nxtRw)
End If
Next
End With
End Sub


but it only reports FIRST single occurrence in sheet 1. Can you please help me in defining a loop to repeat the search till all the occurrence are reported in sheet 2 for the values in Sheet 3.

Thank much in advance.

Hi,

You could use a second loop with the CountIf function as follows:

Option Explicit

Sub Find_Multiple_Values()

Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim WhatToFind As Variant
Dim iCtr As Long
Dim DestCell As Range
Dim iLoop As Long

Set wks = ActiveSheet
Set rngToSearch = wks.Columns(5)

WhatToFind = Array("Weekly", "Monthly", "Annually")

With rngToSearch
    For iCtr = LBound(WhatToFind) To UBound(WhatToFind)
        Set rngFound = .Cells(.Cells.Count)
            For iLoop = 1 To WorksheetFunction.CountIf(rngToSearch, WhatToFind(iCtr)) ' second loop
                    Set rngFound = .Cells.Find(What:=WhatToFind(iCtr), _
                    LookIn:=xlValues, LookAt:=xlWhole, _
                    After:=rngFound, _
                    MatchCase:=False)
            If Not rngFound Is Nothing Then
                MsgBox rngFound
            End If
        Next iLoop
    Next
End With

End Sub

See here for more information - Excel VBA Loops: Correct/Efficient Uses of Excel Loops. Do, For Each and While Loops