Can I condense this?

nuwerty

New Member
Joined
Aug 4, 2010
Messages
18
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.
 

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Scott Huish

MrExcel MVP
Joined
Mar 17, 2004
Messages
19,953
Office Version
365, 2010
Platform
Windows
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

MrExcel MVP
Joined
Jan 15, 2007
Messages
23,770
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.

Code:
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.

Code:
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.
 
Last edited:

nuwerty

New Member
Joined
Aug 4, 2010
Messages
18
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.
 

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Threads
1,106,502
Messages
5,511,693
Members
408,859
Latest member
willm57

This Week's Hot Topics

  • Turn fraction around
    Hello I need to turn a fraction around, for example I have 1/3 but I need to present as 3/1
  • TIme Clock record reformatting to ???
    Hello All, I'd like some help formatting this (Tbl-A)(Loaded via Power Query) [ATTACH type="full" width="511px" alt="PQdata.png"]22252[/ATTACH]...
  • TextBox Match
    hi, I am having a few issues with my code below, what I need it to do is when they enter a value in textbox8 (QTY) either 1,2 or 3 the 3 textboxes...
  • Using Large function based on Multiple Criteria
    Hello, I can't seem to get a Large formula to work based on two criteria's. I can easily get a oldest value based one value, but I'm struggling...
  • Can you check my code please
    Hi, Im going round in circles with a Compil Error End With Without With Here is the code [CODE=rich] Private Sub...
  • Combining 2 pivot tables into 1 chart
    Hello everyone, My question sounds simple but I do not know the answer. I have 2 pivot tables and 2 charts that go with this. However I want to...
Top