Auto replace multiple misspelt country names to a single name

Question

I noticed data cleaning is time-consuming with Excel feedback forms. So, I wrote a VBA code to check all cells in the country column and replace the different variants of a country name by a single one.

Sub Test1()

  Dim val As Long
  Dim x As Integer

  NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
  Range("A2").Select
  For x = 1 To NumRows
      val = ActiveCell.Value  
      If val = "Us" Or val = "Usa" Or val = "Unites States" Or 
         val = "America" Or val = "United States of America" Then

       ActiveCell.Value = "USA"

      Else
      ActiveCell.Value = "ROW"

      End If

     ActiveCell.Offset(1, 0).Select
  Next

End Sub

It does not seem to work. Where am i going wrong ? Also, is there any better way to go about solving this.

Answer 1

For starters, 'val' is not a long, but a string ;-)

I always loop through cells in a range using 'for each c in rng', which is better readable than skipping to a new cell manually with cell.offset.

Try this; change 'rng' according to your needs.

Option Explicit

Sub Test1()

  Dim str As String
  Dim c As Range
  Dim rng As Range

  Set rng = Activesheet.Range("B2:B" & Activesheet.Range("B" & Rows.Count).End(xlUp).row)

  For Each c In rng
      str = c.Value
      If str = "Us" Or val = "Usa" Or str = "Unites States" Or str = "America" Or str = "United States of America" Then
       c.Value = "USA"
      Else
       c.Value = "ROW"
      End If
  Next c

End Sub