How can I get this Excel VBA to run for all rows, instead of just the first row? - excel

Question

So darn new to VBA, almost got this working. I'm trying to reset some Data Validation lists so that if someone changes a Country selection, then a couple of cells will reset. Example, if I pick USA then I want the corresponding State and Shift column to display "Please select..." and if the user changes the country to something other than USA then it doesn't say anything in the State column, only in the Shift column. I got this working but it only runs for the first row. I'm not sure if my range is wrong or if I'm supposed to loop, both of which I'm totally ignorant on.
Option Explicit
'The way this works is if the Payroll Country changes then the sub selections
'of State and Shift should reset based on if the country is USA
'Payroll Country = A column
'State = X column
'Shift = Y column
Private Sub Worksheet_Change(ByVal Target As Range)
'"If Target.Count > 1 Then Exit Sub" is the VBA code to prevent an error if user highlights the range and deletes the data
If Target.Count > 1 Then Exit Sub
If Target.Address = "$A$6" And Target.Value = "USA" Then
Range("X6").Value = "Please select..."
Range("Z6").Value = "Please select..."
ElseIf Target.Address = "$A$6" And Target.Value <> "USA" Then
Range("X6").Value = ""
Range("Z6").Value = "Please select..."
End If
End Sub

Answer 1

Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub 'CountLarge handles larger ranges...
'check Target column and row...
If Target.Column = 1 and Target.Row >= 6 Then
With Target.EntireRow
.Columns("X").Value = IIf(Target.Value = "USA", _
"Please select...", "")
.Columns("Z").Value = "Please select..."
End With
End If
End Sub

Answer 2

A Worksheet Change
If you out-comment the line Application.EnableEvents = False you will notice that there will be more Debug.Print lines (one more for USA, two more for non-USA) i.e. after writing (crg.Value = InitialString), the code calls itself (actually the worksheet change event calls the InitializeCountry procedure) again but 'luckily' exits after the line If irg Is Nothing Then Exit Sub since it is writing to a non-intersecting range, but nevertheless debug-printing the Source Range Address once more, before it continues with the line Debug.Print "Criteria Range (Both Columns): " & crg.Address(0, 0). This should help you to fully understand why the disabling of events is necessary.
Out-comment or delete the range addresses related Debug.Print lines when done testing because they're slowing down the code.
Sheet Module e.g. Sheet1
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
InitializeCountry Target
End Sub
Standard Module e.g. Module1
Option Explicit
Sub InitializeCountry( _
ByVal Target As Range)
' Declare constants.
Const SourceFirstCellAddress As String = "A6"
Const StateColumn As String = "X"
Const ShiftColumn As String = "Z"
Const CriteriaString As String = "USA"
Const InitialString As String = "Please select..."
' Read.
Dim ws As Worksheet: Set ws = Target.Worksheet
Dim sfCell As Range: Set sfCell = ws.Range(SourceFirstCellAddress)
Dim srg As Range: Set srg = sfCell.Resize(ws.Rows.Count - sfCell.Row + 1)
Debug.Print "Source Range Address: " & srg.Address(0, 0)
Dim irg As Range: Set irg = Intersect(srg, Target) ' Intersect Range
If irg Is Nothing Then Exit Sub
Debug.Print "Intersect Range Address: " & irg.Address(0, 0)
' ShiftColumn
Dim crg As Range ' Criteria Range
Set crg = irg.EntireRow.Columns(ShiftColumn)
Debug.Print "Criteria Range (ShiftColumn): " & crg.Address(0, 0)
' StateColumn
Dim erg As Range ' Empty Range
Dim iCell As Range ' Current Intersect Cell
For Each iCell In irg.Cells
If iCell.Value = CriteriaString Then
Set crg = Union(crg, iCell.EntireRow.Columns(StateColumn))
Else
If erg Is Nothing Then
Set erg = iCell.EntireRow.Columns(StateColumn)
Else
Set erg = Union(erg, iCell.EntireRow.Columns(StateColumn))
End If
End If
Next iCell
' Write.
Application.ScreenUpdating = False
' This is crucial to not retrigger the event procedure when writing!
Application.EnableEvents = False
On Error GoTo ClearError
crg.Value = InitialString
Debug.Print "Criteria Range (Both Columns): " & crg.Address(0, 0)
If Not erg Is Nothing Then
erg.ClearContents ' erg.Value = Empty
Debug.Print "Empty Range (StateColumn): " & erg.Address(0, 0)
End If
SafeExit:
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
ClearError:
' Don't uncomment this line!
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub
' Test multi-range (only possible with VBA).
Sub InitializeCountryTEST()
Dim rg As Range: Set rg = Range("A6:A20,A31:A50,A61:A100")
rg.Value = "USA"
End Sub
' Debug.Print result for 'USA' (no 'Empty Range'):
'Source Range Address: A6:A1048576
'Intersect Range Address: A6:A20,A31:A50,A61:A100
'Criteria Range(ShiftColumn): Z6:Z20
'Criteria Range (Both Columns): Z6:Z20,X6:X20,X31:X50,X61:X100
' Debug.Print result otherwise:
'Source Range Address: A6:A1048576
'Intersect Range Address: A6:A20,A31:A50,A61:A100
'Criteria Range(ShiftColumn): Z6:Z20
'Criteria Range (Both Columns): Z6:Z20
'Empty Range (StateColumn): X6:X20,X31:X50,X61:X100