Loop through entire sheet in VBA

[Ash3d]

Hello!

I've been stuck on this one task for a while now and I was hoping to get some help.

I currently have a spreadsheet of data ranging from A1:AF60, some of which are in BOLD text. I need to loop through each cell in the entire spreadsheet and select the entire row if that row contains a cell with bold text in it.

I am then required to copy these select rows and paste them in a different workbook.

So far, I have the following code. It stops at the first row and does not loop through the entire sheet. How can I fix this? Any additions to the code is more than welcome.

[INDENT]Sub TestLoop()
[/INDENT]
[INDENT=2]Dim LastRow As Long, LastColumn As Long, i As Long, j As Long[/INDENT]
[INDENT=2]LastRow = Range("A" & Rows.Count).End(xlUp).Row[/INDENT]
[INDENT=2]LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
[/INDENT]
[INDENT=2]    For i = 1 To LR
[/INDENT]
[INDENT=2]        For j = 1 To LC[/INDENT]
[INDENT=2]            If ActiveCell.Font.Bold = True Then
[/INDENT]
[INDENT=2]              ActiveCell.EntireRow.Select
[/INDENT]
[INDENT=2]            End If
[/INDENT]
[INDENT=2]        Next j
[/INDENT]
[INDENT=2]   Next i
[/INDENT]
[INDENT]End Sub
[/INDENT]

Thanks!

​

-Ash

 

[Norie]

Ash

You've used LastRow and LastColumn to hold the values for last column and row, but in the loops you've used LR and LC.

So perhaps just a little adjustment.

For i = 1 To LastRow
        For j = 1 To LastColumn

 

[Rick Rothstein]

I currently have a spreadsheet of data ranging from A1:AF60, some of which are in BOLD text. I need to loop through each cell in the entire spreadsheet and select the entire row if that row contains a cell with bold text in it.

I am then required to copy these select rows and paste them in a different workbook.

So far, I have the following code. It stops at the first row and does not loop through the entire sheet. How can I fix this? Any additions to the code is more than welcome.

[INDENT]Sub TestLoop()
[/INDENT]
[INDENT=2]Dim LastRow As Long, LastColumn As Long, i As Long, j As Long[/INDENT]
[INDENT=2]LastRow = Range("A" & Rows.Count).End(xlUp).Row[/INDENT]
[INDENT=2]LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
[/INDENT]
[INDENT=2]  For i = 1 To LR
[/INDENT]
[INDENT=2]      For j = 1 To LC[/INDENT]
[INDENT=2][B][COLOR=#a52a2a]          If ActiveCell.Font.Bold = True Then
[/COLOR][/B][/INDENT]
[INDENT=2][B][COLOR=#a52a2a]            ActiveCell.EntireRow.Interior.ColorIndex = 4[/COLOR][/B][/INDENT]
[INDENT=2]          End If
[/INDENT]
[INDENT=2]      Next j
[/INDENT]
[INDENT=2] Next i
[/INDENT]
[INDENT]End Sub
[/INDENT]

Your code is not doing what you say you want it to... nothing is selected, you only (try) to color the cell's interiors. The problem with your code is that you are using the ActiveCell which never changes unless you activate another cell, which you are not doing, so the same cell gets processed over and over again during both loops. Better than using the ActiveCell would be to use a direct reference to the cell itself via the row and column you are iterating over. Try replacing the two lines of code I highlighted in red with these three code lines...

If Cells(i, j).Font.Bold Then
  Cells(i, j).EntireRow.Interior.ColorIndex = 4
  Exit For

The "Exit For" I put in is because once you found a bold cell on the row and, hence colored the entire row, there is no need to look at the rest of the cells on that row (how many times do you need to color the entire row), so you might as well stop looking and move on to the next row.

Also note that your LR and LC variables used in your For..Next loops should be LastRow and LastColumn to match the variable names you used for those values.

 

[texasalynn]

You have LR in the loop without every defining it.

 

[Ash3d]

Thank you! The loops sure work now. I suppose I forgot to change the variable names from LR and LC to LastRow and LastColumn. Sorry about that. I appreciate you input!

 

[Snakehips]

Ash3d,

In addition to all the above you may need to watch the fact that you have a loop within a loop.

At the moment I assume that you are highlighting the row with the bold find, as a test. In which case it will loop and show the row highlighted.

If you substitute a copy / paste to your new sheet then there is a danger that you will copy paste the same row more than once if there is more than cell in that row that is bold.

On the assumption that you will only want to copy once then you will want to break out of the cloumn loop after pasting.

So perhaps something like this with your actual sheet name...

Sub TestLoop()
Dim LastRow As Long, LastColumn As Long, i As Long, j As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LR
For j = 1 To LC
If Cells(i, j).Font.Bold = True Then
Cells(i, j).EntireRow.Interior.ColorIndex = 4  'test only?
NewLR = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1  'next row in dest sheet
Cells(i, j).EntireRow.Copy Destination:=Sheets("Sheet2").Cells(NewLR, 1) 'edit sheet
Application.CutCopyMode = False
GoTo NextRow
End If
Next j
NextRow:
Next i
End Sub

Hope that helps.

 

[Rick Rothstein]

On the assumption that you will only want to copy once then you will want to break out of the cloumn loop after pasting.

So perhaps something like this with your actual sheet name...

Sub TestLoop()
Dim LastRow As Long, LastColumn As Long, i As Long, j As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LR
For j = 1 To LC
If Cells(i, j).Font.Bold = True Then
Cells(i, j).EntireRow.Interior.ColorIndex = 4  'test only?
NewLR = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1  'next row in dest sheet
Cells(i, j).EntireRow.Copy Destination:=Sheets("Sheet2").Cells(NewLR, 1) 'edit sheet
Application.CutCopyMode = False
GoTo NextRow
End If
Next j
NextRow:
Next i
End Sub

I think using "Exit For" like I proposed in Message #3 is a cleaner way to do this than using GoTo plus a Label.

 

[Snakehips]

Rick,

Thank you.
I had not spotted your reference to the need to break out in #3 and for some reason I habitually code a Goto.

The point is noted.

 

[Ash3d]

Thanks Tony and Rick!

Your ideas are brilliant. I got the loops to work. I guess I just need to read my VBA books more closely.