vba code for excel to Search, Replace corresponding data on different column

Question

I have the below (simplified) example of something I am trying to get vba to do for me in excel. There are 3 columns, the second and third columns may have different titles but basically have the same data. And I would like to keep those two columns.

I would like to find on only the second column certain things and then replace the value on the first column of the row that has the value I am searching for. So as a simple example, I will search only column 2 for all "505" and then replace column 1 of those corresponding rows with "A".

Note, this massive spreadsheet and its data changes everyday, so there is no set number of rows or frequencies of "505". So I will need this to loop. Also, I would need to keep both columns 2 and 3 even though most of the data is repetitive. Can someone help with a simple and robust way of doing this? Thanks in advance!

TYPE    ID  Model
E   505 505
E   505 505
E   505 505
E   505 505
E   606 606
E   606 606
E   606 606
E   606 606

Code:

Sub searchrange()
'
' searchrange Macro
'
Dim searchrange As Range
    Range("A1").Select
    Cells.Find(What:="id", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

   'this below line is what I am having trouble with; I need to get the (active, or certain) column to be defined as the search range.
    searchrange = ActiveCell.EntireColumn.Select

    Selection.Find(What:="606", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.Offset(0, -1).FormulaR1C1 = "A"

    Cells.FindNext(After:=ActiveCell).Activate
    Selection.Offset(0, -1).FormulaR1C1 = "A"

End Sub

score 1 · Answer 1 · 2018-07-23T20:55:29.583

Use Find/FindNext to locate all of the 505 cells. Collect your finds into a Union. Offset the Union'ed range to change the values in the first column.

Option Explicit

Sub Macro1()
    Dim rng As Range, addr As String, fnd As Variant, rngs As Range
    dim i as long, arr as variant

    arr = array("505", "A", "506", "B", "507", "C", "508", "D", "509", "E")

    With Worksheets("Sheet2").Columns(2)
        for i=lbound(arr) to ubound(arr) step 2
            fnd = arr(i)
            Set rng = .Find(What:=fnd, After:=.Cells(1), LookAt:=xlWhole, _
                            LookIn:=xlFormulas, MatchCase:=False, SearchFormat:=False)
            If Not rng Is Nothing Then
                addr = rng.Address(0, 0)
                Set rngs = rng
                Do
                    Set rngs = Union(rngs, rng)
                    Set rng = .FindNext(After:=rng)
                Loop Until rng.Address(0, 0) = addr
            End If

            If Not rngs Is Nothing Then _
                rngs.Offset(0, -1) = arr(i+1)
        next i
    End With

End Sub

With your own code, you do not assign a range var to a 'range object select' You Set the range var to the range object.

Set searchrange = ActiveCell.EntireColumn

How to avoid using Select in Excel VBA

Thank you, this worked very well. And you kept it very simple/clean. Also, I was not aware of the union function. The .select in my code was included in error, as I was trying other methods to do this. I have a follow up question: I have a list of about 10 items (505s in example) that I would like to change the type for. This list may increase. Currently I have your suggested code to do this ten times, once for each item. Would it be easier for me to just keep repeating the code for additional items, or to have your code loop through a list? Please let me know your thoughts. — Growth128, Jul 23 '18 at 19:59
Thank you, this works very well! You made it look simple also. I was going down a different much more complex path, that is sure to end up not working. Also, I learned from your code that we can do step 2, step 3. Thank you again, very much appreciated. — Growth128, Jul 24 '18 at 18:54

score 0 · Answer 2 · answered Jul 17 '18 at 19:39

Alternate that will prompt you to enter the ID to search for and the new Type to set those rows to. This also uses the AutoFilter method instead of a Range loop to show a different type of solution:

Sub ReplaceType()

    'Change these to the actual columns for your data
    Const sTypeCol As String = "A"
    Const sIDCol As String = "B"

    Dim ws As Worksheet
    Dim rUpdate As Range
    Dim sIDFind As String
    Dim sNewType As String

    sIDFind = InputBox("Enter the ID to search for:", "ID")
    If Len(sIDFind) = 0 Then Exit Sub   'Pressed cancel

    sNewType = InputBox("Enter the new Type for ID [" & sIDFind & "]:", "New Type")
    If Len(sNewType) = 0 Then Exit Sub  'Pressed cancel

    Set ws = ActiveWorkbook.ActiveSheet
    If ws.AutoFilterMode = True Then ws.AutoFilterMode = False
    With ws.Range(ws.Cells(1, sIDCol), ws.Cells(ws.Rows.Count, sIDCol).End(xlUp))
        If .Rows.Count = 1 Then
            MsgBox "No data on sheet [" & ws.Name & "]" & Chr(10) & "Make sure the correct sheet is selected."
            Exit Sub
        End If
        .AutoFilter 1, sIDFind
        On Error Resume Next
        Set rUpdate = Intersect(ws.Columns(sTypeCol), .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow)
        On Error GoTo 0
        .AutoFilter
    End With

    If Not rUpdate Is Nothing Then
        rUpdate.Value = sNewType
        MsgBox "Updated " & rUpdate.Cells.Count & " cells for ID [" & sIDFind & "] to new Type: " & sNewType
    Else
        MsgBox "No IDs found matching [" & sIDFind & "]", , "No Matches"
    End If

End Sub

score 0 · Answer 3 · answered Jul 18 '18 at 05:26

you could use formulas:

Sub searchrange()
    With Range("A2", Cells(Rows.Count, 1).End(xlUp)) ' reference active sheet column A cells from row 2 down to last not empty one
        .FormulaR1C1 = "=IF(RC3=505,""A"",""E"")" ' write referenced cells with a formula that places an "A" if corresponding column C cell content is 505, otherwise an "E" 
        .Value = .Value ' get rid of formulas and leave values only
    End With
End Sub

what above assumes that the dfault value in column A is "E". should that not ben true and column A cells content could be whatever, then the code changes a bit, exploiting a helper range in column D

Sub searchrange2()
    With Range("A2", Cells(Rows.Count, 1).End(xlUp)) ' reference active sheet column A cells from row 2 down to last not empty one
        .Offset(, 3).FormulaR1C1 = "=IF(RC3=505,""A"",RC1)" ' write referenced cells offset three column to the right (i.e. column D) with a formula that places an "A" if corresponding column C cell content is 505, otherwise the content of corresponding column A cell 
        .Value = .Offset(, 3).Value ' write formula result in column A cells 
        .Offset(, 3).ClearContents ' clear "helper" column D 
    End With
End Sub

vba code for excel to Search, Replace corresponding data on different column

3 Answers3