PDA

View Full Version : Format from last Row Up



jo15765
07-31-2013, 10:45 AM
I am using a refreshable spreadsheet that must have certain formatting. So any new data (data that is pulled in from the new refresh) would not have the current formatting. What I need to do is find all cells that do not have borders that contain data, select columns B - AI and apply a thin border to the Horizontal, Right, Top, Left & Bottom, then set the Row Height to 34.5

I am attaching a sample workbook for reference, the top half contains what the data should look like, and the bottom half contains the new data that needs the formatting.

1034310343

GarysStudent
07-31-2013, 11:28 AM
I would ignore the fact that part of the data has already been formated, format it anyway:


Sub Macro1()
ActiveSheet.UsedRange.Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

ActiveSheet.UsedRange.EntireRow.RowHeight = 34.2
End Sub

jo15765
07-31-2013, 11:54 AM
And if they wanted to go back and add a header row to the top, how would I exclude the 1st row from the formatting?

GarysStudent
07-31-2013, 12:12 PM
Replace:


Activesheet.Usedrange.Select
with

Dim r As Range
Dim rReduced As Range
Set rReduced = Nothing
For Each r In ActiveSheet.UsedRange
If Intersect(r, Rows("1:1")) Is Nothing Then
If rReduced Is Nothing Then
Set rReduced = r
Else
Set rReduced = Union(rReduced, r)
End If
End If
Next
rReduced.Select