CODEWITHSUNDEEP
excelreplacemultiple-columnsvba
user3265840
user3265840

Reputation: 11

Replacing values in multiple columns

I am new to vba so bear with me.

I need to replace values in multiple columns in a worksheet. There are about 50 values that need to be matched and replaced if present.

For example: I want to search in column C and F to see if any of my listed values exist and then replace it with another text. Every searched value have a unique replacement.

Preferably if the string can search and replace both columns with the same lookup. Not have several statements for every column.

This is what I tried to use:

Sub reppp()

    Columns("C:C").Replace What:="Search1", Replacement:="Text1", SearchOrder:=xlByColumns
    Columns("F:F").Replace What:="Search1", Replacement:="Text1", SearchOrder:=xlByColumns
    Columns("C:C").Replace What:="Search2", Replacement:="Text2", SearchOrder:=xlByColumns
    Columns("F:F").Replace What:="Search2", Replacement:="Text2", SearchOrder:=xlByColumns

End Sub

As it is I need to change/add 2 entries for every "replace".

I also get new work sheets which need this treatment regulary. What is the easiest way to convert these sheets to my specifications? Is there a way to state the search and replacements in a separate worksheet and somehow call that document and run the macro?

Upvotes: 1

Views: 5537

Answers (3)

MrP
MrP

Reputation: 11

If your table is set up without gaps in the data, using the UsedRange is a good method for what you need.

Range("C:C,F:F").Select With ActiveSheet.UsedRange .Replace "Search1", "Text1", xlPart .Replace "Search2", "Text2", xlPart .Replace "Search3", "Text3", xlPart .Replace "Search4", "Text4", xlPart .Replace "Search5", "Text5", xlPart .Replace "Search6", "Text6", xlPart .Replace "Search7", "Text7", xlPart End With

Upvotes: 0

WGS
WGS

Reputation: 14169

Following the logic of my post here, here's a code that suits your needs.

Sub FindReplaceWithRef()

    Dim Wbk As Workbook: Set Wbk = ThisWorkbook
    Dim Wsht As Worksheet: Set Wsht = Wbk.Sheets("Sheet1") 'Modify as needed.
    Dim Dict As Object
    Dim RefList As Range, RefElem As Range
    Dim TargetRng As Range

    Set Dict = CreateObject("Scripting.Dictionary")
    Set RefList = Wsht.Range("J1:J3") 'Modify as needed.
    Set TargetRng = Union(Wsht.Range("C1:C20"), Wsht.Range("F1:F20")) 'Modify as needed.

    With Dict
        For Each RefElem In RefList
            If Not .Exists(RefElem) And Not RefElem Is Nothing Then
                .Add RefElem.Value, RefElem.Offset(0, 1).Value
            End If
        Next RefElem
    End With

    For Each Key In Dict
        With TargetRng
            .Replace What:=Key, Replacement:=Dict(Key)
        End With
    Next Key

    Set Dict = Nothing

End Sub

Screenshots:

Before running code:

enter image description here

After running code:

enter image description here

Let us know if this helps.

Upvotes: 1

Gary's Student
Gary's Student

Reputation: 96753

This should meet your needs:

Sub demo()
    Dim r As Range
    Set r = Range("C:C, F:F")
    ary1 = Array("Search1", "Search2")
    ary2 = Array("Text1", "Text2")
    For i = 0 To 1
        r.Replace What:=ary1(i), Replacement:=ary2(i)
    Next i
End Sub

Note:

You can increase the arrays and modify the For statement to expand the translation table.

Upvotes: 0

Related Questions