Forum Discussion

Copper Contributor

Jul 21, 2022

Solved

Find in excel VBA

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 t...

Macros and VBA

HansVogelaar

Jul 22, 2022

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

HansVogelaar

MVP

Jul 27, 2022

mlondonop

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

mlondonop

Copper Contributor

Jul 27, 2022

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.

HansVogelaar

MVP

Jul 27, 2022

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