SOLVED

Find in excel VBA

Copper Contributor

I am trying to use the find function in excel VBA inside of a loop. Frist pass would make the "what" in this find function as the value in file A cell B4, and then look for this value in file B and the do an overwrite of values on that row using offset. The next look the "what" in the find would need to look for the value in file A cell B12, the next loop the "what would be the value in B20, the next loop in B28, etc. until it reaches the last row of data in File A. I know how to do loops but I do not know how to use Find within a loop nor do I know how to do Find across various workbooks because the syntax for Find is very specific. Any help on this would be appreciated.

7 Replies
best response confirmed by mlondonop (Copper Contributor)
Solution

@mlondonop 

Your description is not very specific, so my reply is vague too.

By "file", do you mean a worksheet in the active workbook?

Sub ReplaceLoop()
    ' Column to search on sheet B
    Const col = "D"
    ' Offset to use
    Const offs = 5
    ' Replacement text
    Const repl = "Replacement Text"
    Dim wsA As Worksheet
    Dim wsB As Worksheet
    Dim r As Long
    Dim m As Long
    Dim s As String
    Dim rng As Range
    Dim adr As String
    Application.ScreenUpdating = False
    ' Use the real names of the worksheets
    Set wsA = Worksheets("A")
    Set wsB = Worksheets("B")
    m = wsA.Range("B" & wsA.Rows.Count).End(xlUp).Row
    For r = 4 To m Step 8
        s = wsA.Range("B" & r).Value
        Set rng = wsB.Columns(col).Find(What:=s, LookAt:=xlWhole)
        If Not rng Is Nothing Then
            adr = rng.Address
            Do
                rng.Offset(0, offs).Value = repl
                Set rng = wsB.Columns(col).Find(What:=s, After:=rng, LookAt:=xlWhole)
                If rng Is Nothing Then Exit Do
            Loop Until rng.Address = adr
        End If
    Next r
    Application.ScreenUpdating = True
End Sub
Hello Hans, thank you for your quick reply. I am a bit slow to review to be able to let you know if this worked or not because I am about to leave office for a few weeks for the birth of a new baby. But I can at least answer your question. By new "file" I mean entire different workbook, not just different worksheet in the active workbook. That's part of the reason I was having difficulty in the syntax of the find function.

@mlondonop 

I hope everything will go well!

 

Do those workbooks contain multiple sheets?

If so, do you want to search all sheets, or only a specific one?

Yes both workbooks will contain multiple sheets. But I only need to search 1 specific sheet.

@mlondonop 

Thanks. Will that be the first sheet in the workbook? Or does it have the same name in all workbooks?

Thank you very much. In the notebook where I am getting the "what" it is sheet(1) and in the sheet where I will perform the search it will be a specific sheet with name "shortage list". Also by the way once I find a match I will use the offset to replace text in various different cells in the "shortage list" from various cells in the row where the "what" is located. I intend to do so with multiple offset instructions.

@mlondonop 

Here is a new version:

Sub ReplaceLoop()
    ' Column to search on sheet B
    Const col = "D"
    ' Offset to use
    Const offs1 = 5
    Const offs2 = 9
    ' *** add more offsets as needed ***
    ' Replacement text
    Const repl1 = "Replacement Text 1"
    Const repl2 = "Replacement Text 2"
    ' *** add more replacement texts as needed ***
    Dim vFile
    Dim wbA As Workbook
    Dim wsA As Worksheet
    Dim wbB As Workbook
    Dim wsB As Worksheet
    Dim r As Long
    Dim m As Long
    Dim s As String
    Dim rng As Range
    Dim adr As String
    vFile = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls*),*.xls*")
    If vFile = False Then
        Beep
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Set wbA = ActiveWorkbook
    Set wsA = wbA.Worksheets("Sheet(1)")
    Set wbB = Workbooks.Open(Filename:=vFile)
    Set wsB = wbB.Worksheets("shortage list")
    m = wsA.Range("B" & wsA.Rows.Count).End(xlUp).Row
    For r = 4 To m Step 8
        s = wsA.Range("B" & r).Value
        Set rng = wsB.Columns(col).Find(What:=s, LookAt:=xlWhole)
        If Not rng Is Nothing Then
            adr = rng.Address
            Do
                rng.Offset(0, offs1).Value = repl1
                rng.Offset(0, offs2).Value = repl2
                ' *** Add more lines as needed ***
                Set rng = wsB.Columns(col).Find(What:=s, After:=rng, LookAt:=xlWhole)
                If rng Is Nothing Then Exit Do
            Loop Until rng.Address = adr
        End If
    Next r
    ' Close and save workbook
    wbB.Close SaveChanges:=True
    Application.ScreenUpdating = True
End Sub
1 best response

Accepted Solutions
best response confirmed by mlondonop (Copper Contributor)
Solution

@mlondonop 

Your description is not very specific, so my reply is vague too.

By "file", do you mean a worksheet in the active workbook?

Sub ReplaceLoop()
    ' Column to search on sheet B
    Const col = "D"
    ' Offset to use
    Const offs = 5
    ' Replacement text
    Const repl = "Replacement Text"
    Dim wsA As Worksheet
    Dim wsB As Worksheet
    Dim r As Long
    Dim m As Long
    Dim s As String
    Dim rng As Range
    Dim adr As String
    Application.ScreenUpdating = False
    ' Use the real names of the worksheets
    Set wsA = Worksheets("A")
    Set wsB = Worksheets("B")
    m = wsA.Range("B" & wsA.Rows.Count).End(xlUp).Row
    For r = 4 To m Step 8
        s = wsA.Range("B" & r).Value
        Set rng = wsB.Columns(col).Find(What:=s, LookAt:=xlWhole)
        If Not rng Is Nothing Then
            adr = rng.Address
            Do
                rng.Offset(0, offs).Value = repl
                Set rng = wsB.Columns(col).Find(What:=s, After:=rng, LookAt:=xlWhole)
                If rng Is Nothing Then Exit Do
            Loop Until rng.Address = adr
        End If
    Next r
    Application.ScreenUpdating = True
End Sub

View solution in original post