B
Brent
i have a report that is imported into a worksheet from external data
in a database.
I am using Macros to format and filter the report.
The number of rows in the report can change each time it is refreshed.
I would like to add borders to all cells in the report but I do not
want the macro to continue adding borders once it gets to the last row
or column in the report.
There can be the odd random blank cell in the report but and I would
rather these cells are not skipped and still formatted with a border.
I have only come up with a way to keep adding borders down a column
untill it comes across 1 empty cell and then offsets to the next
column and starts again. This does not work if it comes accross a
blank cell halfway down the column. I wonder if I can run this loop
until it comes across 5 empty cells in succession in the column.
If you use the macro below on a sheet with 6 columns and 100 rows of
dummy data you will see how it works. Im sure there is a far better
way?
Sub borderallnonblankcells()
Dim Resp As VbMsgBoxResult
Resp = MsgBox(prompt:=" Do you want cell borders to the Rport?",
Buttons:=vbYesNo)
If Resp = vbYes Then
' code if user clicked 'Yes'
Application.ScreenUpdating = False
oldSB = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "GENERATING REPORT PLEASE WAIT"
Application.ScreenUpdating = False
'Code
Range("A3").Activate
Do Until ActiveCell.Value = ""
Selection.Borders.Value = 1
ActiveCell.Offset(1, 0).Select
Loop
'HOME OFSET col 1 AND LOOP AGAIN
Range("A3").Activate
ActiveCell.Offset(0, 1).Select
Do Until ActiveCell.Value = ""
Selection.Borders.Value = 1
ActiveCell.Offset(1, 0).Select
Loop
'HOME OFSET col 2 AND LOOP AGAIN
Range("A3").Activate
ActiveCell.Offset(0, 2).Select
Do Until ActiveCell.Value = ""
Selection.Borders.Value = 1
ActiveCell.Offset(1, 0).Select
Loop
'HOME OFSET col 3 AND LOOP AGAIN
Range("A3").Activate
ActiveCell.Offset(0, 3).Select
Do Until ActiveCell.Value = ""
Selection.Borders.Value = 1
ActiveCell.Offset(1, 0).Select
Loop
'HOME OFFSET col 4 AND LOOP AGAIN
Range("A3").Activate
ActiveCell.Offset(0, 4).Select
Do Until ActiveCell.Value = ""
Selection.Borders.Value = 1
ActiveCell.Offset(1, 0).Select
Loop
'HOME OFFSET col 5 AND LOOP AGAIN
Range("A3").Activate
ActiveCell.Offset(0, 5).Select
Do Until ActiveCell.Value = ""
Selection.Borders.Value = 1
ActiveCell.Offset(1, 0).Select
Loop
'HOME OFFSET col 5 AND LOOP AGAIN
Range("A3").Activate
ActiveCell.Offset(0, 6).Select
Do Until ActiveCell.Value = ""
Selection.Borders.Value = 1
ActiveCell.Offset(1, 0).Select
Loop
Application.StatusBar = False
Application.DisplayStatusBar = oldSB
Application.ScreenUpdating = True
Else
Range("A1").Activate
End If
End Sub
in a database.
I am using Macros to format and filter the report.
The number of rows in the report can change each time it is refreshed.
I would like to add borders to all cells in the report but I do not
want the macro to continue adding borders once it gets to the last row
or column in the report.
There can be the odd random blank cell in the report but and I would
rather these cells are not skipped and still formatted with a border.
I have only come up with a way to keep adding borders down a column
untill it comes across 1 empty cell and then offsets to the next
column and starts again. This does not work if it comes accross a
blank cell halfway down the column. I wonder if I can run this loop
until it comes across 5 empty cells in succession in the column.
If you use the macro below on a sheet with 6 columns and 100 rows of
dummy data you will see how it works. Im sure there is a far better
way?
Sub borderallnonblankcells()
Dim Resp As VbMsgBoxResult
Resp = MsgBox(prompt:=" Do you want cell borders to the Rport?",
Buttons:=vbYesNo)
If Resp = vbYes Then
' code if user clicked 'Yes'
Application.ScreenUpdating = False
oldSB = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "GENERATING REPORT PLEASE WAIT"
Application.ScreenUpdating = False
'Code
Range("A3").Activate
Do Until ActiveCell.Value = ""
Selection.Borders.Value = 1
ActiveCell.Offset(1, 0).Select
Loop
'HOME OFSET col 1 AND LOOP AGAIN
Range("A3").Activate
ActiveCell.Offset(0, 1).Select
Do Until ActiveCell.Value = ""
Selection.Borders.Value = 1
ActiveCell.Offset(1, 0).Select
Loop
'HOME OFSET col 2 AND LOOP AGAIN
Range("A3").Activate
ActiveCell.Offset(0, 2).Select
Do Until ActiveCell.Value = ""
Selection.Borders.Value = 1
ActiveCell.Offset(1, 0).Select
Loop
'HOME OFSET col 3 AND LOOP AGAIN
Range("A3").Activate
ActiveCell.Offset(0, 3).Select
Do Until ActiveCell.Value = ""
Selection.Borders.Value = 1
ActiveCell.Offset(1, 0).Select
Loop
'HOME OFFSET col 4 AND LOOP AGAIN
Range("A3").Activate
ActiveCell.Offset(0, 4).Select
Do Until ActiveCell.Value = ""
Selection.Borders.Value = 1
ActiveCell.Offset(1, 0).Select
Loop
'HOME OFFSET col 5 AND LOOP AGAIN
Range("A3").Activate
ActiveCell.Offset(0, 5).Select
Do Until ActiveCell.Value = ""
Selection.Borders.Value = 1
ActiveCell.Offset(1, 0).Select
Loop
'HOME OFFSET col 5 AND LOOP AGAIN
Range("A3").Activate
ActiveCell.Offset(0, 6).Select
Do Until ActiveCell.Value = ""
Selection.Borders.Value = 1
ActiveCell.Offset(1, 0).Select
Loop
Application.StatusBar = False
Application.DisplayStatusBar = oldSB
Application.ScreenUpdating = True
Else
Range("A1").Activate
End If
End Sub