Hello all,
I'm very new to VBA. Can anybody please help me shorten this code?
All I'm trying to do is find cell entries that exceed 30 characters, highlight the cells, and keep track of how many times this happens. I'm going through seven columns but they're not all adjacent. I need to keep separate counts for each column for a report that is created later. Those two factors lead me to go through each column separately :/
LastRow is passed down from earlier in the macro and is the last row that I need to check.
Dim NameErrors As Integer
Dim Late1Errors As Integer
Dim Late2Errors As Integer
Dim UnitCErrors As Integer
Dim Address1Errors As Integer
Dim Address2Errors As Integer
Dim Address3Errors As Integer
NameErrors = 0
Late1Errors = 0
Late2Errors = 0
UnitCErrors = 0
Address1Errors = 0
Address2Errors = 0
Address3Errors = 0
Range("H1:H1").Select
Do While Not ActiveCell.Row > LastRow
If Len(ActiveCell) > 30 Then
Selection.Interior.ColorIndex = 6
NameErrors = NameErrors + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("I1:I1").Select
Do While Not ActiveCell.Row > LastRow
If Len(ActiveCell) > 30 Then
Selection.Interior.ColorIndex = 6
Late1Errors = Late1Errors + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("J1:J1").Select
Do While Not ActiveCell.Row > LastRow
If Len(ActiveCell) > 30 Then
Selection.Interior.ColorIndex = 6
Late2Errors = Late2Errors + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("K1:K1").Select
Do While Not ActiveCell.Row > LastRow
If Len(ActiveCell) > 30 Then
Selection.Interior.ColorIndex = 6
UnitCErrors = UnitCErrors + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("N1:N1").Select
Do While Not ActiveCell.Row > LastRow
If Len(ActiveCell) > 30 Then
Selection.Interior.ColorIndex = 6
Address1Errors = Address1Errors + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("O1:O1").Select
Do While Not ActiveCell.Row > LastRow
If Len(ActiveCell) > 30 Then
Selection.Interior.ColorIndex = 6
Address2Errors = Address2Errors + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("P1:P1").Select
Do While Not ActiveCell.Row > LastRow
If Len(ActiveCell) > 30 Then
Selection.Interior.ColorIndex = 6
Address3Errors = Address3Errors + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
Thanks very much for any input! These boards have already taught me so many things that I didn't know were possible.
I'm very new to VBA. Can anybody please help me shorten this code?
All I'm trying to do is find cell entries that exceed 30 characters, highlight the cells, and keep track of how many times this happens. I'm going through seven columns but they're not all adjacent. I need to keep separate counts for each column for a report that is created later. Those two factors lead me to go through each column separately :/
LastRow is passed down from earlier in the macro and is the last row that I need to check.
Dim NameErrors As Integer
Dim Late1Errors As Integer
Dim Late2Errors As Integer
Dim UnitCErrors As Integer
Dim Address1Errors As Integer
Dim Address2Errors As Integer
Dim Address3Errors As Integer
NameErrors = 0
Late1Errors = 0
Late2Errors = 0
UnitCErrors = 0
Address1Errors = 0
Address2Errors = 0
Address3Errors = 0
Range("H1:H1").Select
Do While Not ActiveCell.Row > LastRow
If Len(ActiveCell) > 30 Then
Selection.Interior.ColorIndex = 6
NameErrors = NameErrors + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("I1:I1").Select
Do While Not ActiveCell.Row > LastRow
If Len(ActiveCell) > 30 Then
Selection.Interior.ColorIndex = 6
Late1Errors = Late1Errors + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("J1:J1").Select
Do While Not ActiveCell.Row > LastRow
If Len(ActiveCell) > 30 Then
Selection.Interior.ColorIndex = 6
Late2Errors = Late2Errors + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("K1:K1").Select
Do While Not ActiveCell.Row > LastRow
If Len(ActiveCell) > 30 Then
Selection.Interior.ColorIndex = 6
UnitCErrors = UnitCErrors + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("N1:N1").Select
Do While Not ActiveCell.Row > LastRow
If Len(ActiveCell) > 30 Then
Selection.Interior.ColorIndex = 6
Address1Errors = Address1Errors + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("O1:O1").Select
Do While Not ActiveCell.Row > LastRow
If Len(ActiveCell) > 30 Then
Selection.Interior.ColorIndex = 6
Address2Errors = Address2Errors + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("P1:P1").Select
Do While Not ActiveCell.Row > LastRow
If Len(ActiveCell) > 30 Then
Selection.Interior.ColorIndex = 6
Address3Errors = Address3Errors + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
Thanks very much for any input! These boards have already taught me so many things that I didn't know were possible.