Update cells and highlight changes based on criteria

ivonsurf123

New Member
Joined
May 17, 2022
Messages
14
Office Version
  1. 2021
Platform
  1. Windows
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
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
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
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top