How do I speed up a CASE statement that loops through a large data set?

[nvdunn]

Hi there
I have a CASE statement that is looping through a very large data set (>75,000 rows) and if the state says "New South Wales" i need it changed to NSW. I need this abbreviation for all Australian states. My code works but it is taking FOREVER to loop through all the data.
Can i convert my data ranges into an array to speed things up? I'm not sure what to do. Basically if the state says New South Wales I want that same cell changed to NSW. Here's my code:
any help is very much appreciated.
Many thanks

---

dim lRowCount as long
Dim i As Long

Application.ScreenUpdating = False

lRowCount = Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lRowCount
strState = Application.Worksheets("ClientAddress").Cells(i, 8) 'being where i'm storing my state value


Select Case strState
Case "New South Wales"
Application.ActiveSheet.Cells(i, 8) = "NSW"
'strState = "NSW"
Case "Queensland"
Application.ActiveSheet.Cells(i, 8) = "QLD"
Case "Victoria"
Application.ActiveSheet.Cells(i, 8) = "VIC"
Case "Tasmania"
Application.ActiveSheet.Cells(i, 8) = "TAS"
Case "Western Australia"
Application.ActiveSheet.Cells(i, 8) = "WA"
Case "Australian Capital Territory"
Application.ActiveSheet.Cells(i, 8) = "ACT"
Case "Northern Territory"
Application.ActiveSheet.Cells(i, 8) = "NT"
Case "South Australia"
Application.ActiveSheet.Cells(i, 8) = "SA"

End Select
Next i

 

[StephenCrump]

No need to loop!

Try something like:

Columns("H:H").Replace What:="New South Wales", Replacement:="NSW", LookAt:=xlPart, MatchCase:=False

etc

 

[Peter_SSs]

I wouldn't discount looping as such. On my machine this is about 10 times faster than doing 8 x Find/Replace over 75,000 rows.

Sub Abbrev_States()
  Dim lRowCount As Long, i As Long
  Dim Adr As Variant
  
  lRowCount = Range("A" & Rows.Count).End(xlUp).Row
  Adr = Sheets("ClientAddress").Range("H2:H" & lRowCount).Value
  For i = 1 To UBound(Adr)
    Select Case Adr(i, 1)
      Case "New South Wales": Adr(i, 1) = "NSW"
      Case "Queensland": Adr(i, 1) = "QLD"
      Case "Victoria": Adr(i, 1) = "VIC"
      Case "Tasmania": Adr(i, 1) = "TAS"
      Case "Western Australia": Adr(i, 1) = "WA"
      Case "Australian Capital Territory": Adr(i, 1) = "ACT"
      Case "Northern Territory": Adr(i, 1) = "NT"
      Case "South Australia": Adr(i, 1) = "SA"
    End Select
  Next i
  Range("H2:H" & lRowCount).Value = Adr
End Sub

Edit: Forgot to mention that I have assumed the sheet that is going to receive the results is the active sheet when the code is run. Not sure what that sheet is called.

 

[nvdunn]

Thank you very much StephenCrump that worked really well! I think I was trying to be too tricky. And it wasn't slow to replace all for all states.
Thanks again

 

[nvdunn]

Thank you very much Peter_SSs i really appreciate your input.

 

[StephenCrump]

I wouldn't discount looping as such. On my machine this is about 10 times faster than doing 8 x Find/Replace over 75,000 rows.

Thanks Peter, I think if anything you've understated the relative speed advantage of the array approach.

I wasn't expecting .Replace to be that slow, and should have tested!

 

[Peter_SSs]

Thanks Peter, I think if anything you've understated the relative speed advantage of the array approach.

I wasn't expecting .Replace to be that slow, and should have tested!

Cheers Stephen. Probably depends somewhat on the machine I expect. For me, copying the range (I did have about 77,000 rows) from one worksheet to the other then 8 x Find/Replace (ScreenUpdating off) took about 1.6 seconds.
Same data, my code took about 0.18 seconds.

 

[nvdunn]

Oh good point. I have a relatively fast machine but the user I am creating this macro for has a pretty poor performance machine. I will test it out on his computer. thanks again guys. Much appreciated