Update cells and highlight changes based on criteria

[ivonsurf123]

Hello,

I am pretty much new on vba excel, is there a way to create a clean code? It works, but I was wonder if there is a more clean or simple way to update and highlight only the cells based on values. Thank you for any help or feedback.

Sub Update ()
Application.ScreenUpdating = False

Dim LastRow As Long, i As Long, ws As Worksheet

[W:W] = [INDEX(TRIM(W:W),)]
[V:V] = [INDEX(TRIM(V:V),)]

Set ws = Sheets("HDAM_MONTH_COMM_WORKING FILE")
LastRow = ws.Range("W" & Rows.Count).End(xlUp).Row 'Finds your last row using Column W

With ws
For i = 2 To LastRow 'Loop from row 2 to last row

Select Case .Range("W" & i).Value
Case "ME", "NH", "MA", "NY", "VT", "RI" ' States
If .Range("A" & i).Value <> "145" Or .Range("O" & i).Value <> "911" Then
.Range("A" & i).Value = "145"
.Range("A" & i).Interior.Color = vbYellow
.Range("O" & i).Value = "911"
.Range("O" & i).Interior.Color = vbYellow
End If
If .Range("A" & i).Value <> "146" Or .Range("O" & i).Value <> "453" Then
Case "IN", "KY", "MI", "OH"
.Range("A" & i).Value = "146"
.Range("O" & i).Value = "453"
End If
If .Range("A" & i).Value <> "506" Or .Range("O" & i).Value <> "454" Then
Case "WA", "OR", "CA", "MT", "ID", "NV", "AZ"
.Range("A" & i).Value = "506"
.Range("O" & i).Value = "454"
End If

End Select
Next i
End With
Application.ScreenUpdating = True
End Sub

 

[ivonsurf123]

Corrections:

Sub Update ()
Application.ScreenUpdating = False

Dim LastRow As Long, i As Long, ws As Worksheet

[W:W] = [INDEX(TRIM(W:W),)]
[V:V] = [INDEX(TRIM(V:V),)]

Set ws = Sheets("HDAM_MONTH_COMM_WORKING FILE")
LastRow = ws.Range("W" & Rows.Count).End(xlUp).Row 'Finds your last row using Column W

With ws
For i = 2 To LastRow 'Loop from row 2 to last row

Select Case .Range("W" & i).Value
Case "ME", "NH", "MA", "NY", "VT", "RI" ' States
If .Range("A" & i).Value <> "145" Or .Range("O" & i).Value <> "911" Then
.Range("A" & i).Value = "145"
.Range("A" & i).Interior.Color = vbYellow
.Range("O" & i).Value = "911"
.Range("O" & i).Interior.Color = vbYellow
End If
Case "IN", "KY", "MI", "OH"
If .Range("A" & i).Value <> "146" Or .Range("O" & i).Value <> "453" Then
.Range("A" & i).Value = "146"
.Range("O" & i).Value = "453"
End If
Case "WA", "OR", "CA", "MT", "ID", "NV", "AZ"
If .Range("A" & i).Value <> "506" Or .Range("O" & i).Value <> "454" Then
.Range("A" & i).Value = "506"
.Range("O" & i).Value = "454"
End If

End Select
Next i
End With
Application.ScreenUpdating = True
End Sub