Excel VBA updating cells with Find/Replace from a different sheet

Question

Hey i have a sheet1 containing a list of search patterns in column A, and a corresponding list of category names in column B. I have a sheet2 which has a list of various descriptions of my bank transactions.

Eg in sheet1 i have groceries, fuel, entertainment, savings, and in sheet2 i have "Shell service station, abc road", "Coles supermarket" etc..

Eg. If i find the word "Shell" in Sheet2 i want to replace that line with the word "Fuel"

So far i have got this working, but i dont believe that it is the most efficient or effective way of doing it. Below is my code.

Sub UpdateCats()
Dim x As Integer
Dim FindString As String
Dim ReplaceString As String
Dim NumRows As Integer
'Replace and update Categories
With Sheets("Categories")
    .Activate
  ' Set numrows = number of rows of data.
  NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
  ' Select cell a1.
  Range("A2").Select
  ' Establish "For" loop to loop "numrows" number of times.
  For x = 1 To NumRows
     FindString = ActiveCell.Value
     ActiveCell.Offset(0, 1).Select
     ReplaceString = ActiveCell.Value
     ActiveCell.Offset(1, -1).Select

     With Sheets("Data")
        .Activate
        'With Columns(2)
        Cells.Replace What:=FindString, Replacement:=ReplaceString, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
        'End With
     End With
     Sheets("Categories").Activate
  Next
End With
End Sub

The reason i dont like my code so far is because it has to continually switching (activating) between sheets as it runs through the loop. Is there a way to do this better?

Answer 1

In general, I don't believe that this a very good way to go. Using "ActiveCell" and ".Activate" is a rather dangerous habit because whatever changes will screw your entire piece of code. Try using a named hierarchy (name application - name workbook - name sheet - dynamic ranges such as named ranges as much as possible). Personally I am also not too fond of the offset function, I don't know why everyone is so crazy about it, to revise this type of code is rather untransparent and you seldomly really need it. You could just load the entire thing in an array of strings and loop through it. It's brief and easy to read.

Answer 2

使用这段代码：

Application.ScreenUpdating=false

Answer 3

This should substantially improve processing time.

Sub UpdateCats()
    Dim v As Long, vFSRSs As Variant

    On Error GoTo bm_Safe_Exit
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    'Replace and update Categories
    With Sheets("Categories")
        vFSRSs = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)).Value2
    End With

    With Sheets("Data")
        With .Columns(2)
            For v = LBound(vFSRSs, 1) To UBound(vFSRSs, 1)
                'Debug.Print vFSRSs(v, 1) & " to " & vFSRSs(v, 2)
                .Replace What:=vFSRSs(v, 1), Replacement:=vFSRSs(v, 2), _
                         LookAt:=xlWhole, MatchCase:=False
            Next v
         End With
    End With

bm_Safe_Exit:
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

By storing the search-for and replacement terms in a two dimensional array, the loop through the worksheet cells is discarded. Additionally, any form of Worksheet.Activate method or range .Select has been avoided.

See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.

Answer 4

I would use built in app functions to your advantage. In my code I have implemented the "TypeName" and "Search" methods to essentially do the same thing as Ctrl+F & Ctrl+replace, it just became a little more readable. I think it is important to be mindful of how powerful VBA methods are and to use those first before resorting to more unorthodox methods.

Sub Cats()

With ThisWorkbook
For i = 1 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

    Dim lookupvalue As String

    lookupvalue = Sheets(1).Cells(i, 1).Value

    For n = 1 To Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row

        If TypeName(Application.Search(lookupvalue, Sheets(2).Cells(n, 1))) = "Double" Then
                Sheets(2).Cells(n, 1).Value = Sheets(1).Cells(i, 2).Value
                GoTo exitloop
        End If
    Next n
exitloop:
Next i

End With

End Sub