Can I condense this?

[nuwerty]

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.

 

[Scott Huish]

You don't really need VBA for this. You could use Conditional Formatting for the highlighting and a SUMPRODUCT formula for the count, assuming you will never use a full column prior to XL2007.

But you rarely need to select in VBA you can work with ranges directly.

 

[mikerickson]

That code can be tightened up.

Data type Integer has a maximum of 32,767. There are 65,536 rows in a worksheet. Data type Long will accommodate all the rows in a worksheet. (This may have changed in 2007.)

That code is looping through every cell in H1:P[LastRow]
Instead of doing it column by column, one can loop though the range as a whole.

Dim oneCell as Range

For Each oneCell in Range("H1:P1").Resize(lastRow, 9)
    Rem do stuff
Next oneCell

Selecting cells slows the code down and often isn't needed.

Dim oneCell as Range

For Each oneCell in Range("H1:P1").Resize(lastRow, 9)
    With oneCell
        If Len(CStr(.Value)) > 30 Then
            .Interior.ColorIndex = 6
            NameErrors = NameErrors + 1
        End If
    End With
Next oneCell

But a non-VBA solution would most likely be best.

 

[nuwerty]

Thanks for the suggestions. I'm using a macro because this is part of a much longer routine that will be executed on a few thousand files, plus I'm doing all the work off the sheet to preserve the overall layout of the file, which will be exported.

I went with a single loop over the whole range and took out the selecting, and it is noticeably faster.

SUMPRODUCT (didn't know about this one but it does seem perfect for this) gave me what I wanted but I gave up on putting it into a macro, just couldn't get the syntax right...I have another working solution. Thanks.