Macro Cell Borders

[fwawergurl16]

Hi. I'm having trouble with doing one of the final part of my macro work, Phase 3. I'm asked to use macro to create some sort of table with borders...I can get all else done, except the border. Is there any way to make it realized? I've tried using the recorded way first, but it just doesn't work when I run it again.

I've attached the sample worksheets as reference. Worksheet 'target' is the intended look, while 'start' is the one that needs to be worked on. Any help is much appreciated!

[mdmackillop]

Is this a "homework" exercise?
In any case I would approach this by looping through Column A looking for Total (see FindNext in VB help), and applying the formatting to a range based on the found cells. Looping can also be used on columns (odd/even numbered) to set column widths

[Bob Phillips]

This should do it all



Sub rL2()
Dim LastRow As Long
Dim i As Long

With Worksheets("start")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range("B6:Q" & LastRow)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
For i = 6 To LastRow
If .Cells(i, "A").Value = "Grand Total" Then
With .Cells(i, "A").Offset(-1, 0).Resize(2, 17)
.Interior.ColorIndex = 40
.Font.Bold = True
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
ElseIf .Cells(i, "A").Value Like "*Total" Then
With .Cells(i, "A").Resize(1, 17)
.Interior.ColorIndex = 35
.Font.Bold = True
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
End If
Next i
End With

End Sub

[fwawergurl16]

Is this a "homework" exercise?
In any case I would approach this by looping through Column A looking for Total (see FindNext in VB help), and applying the formatting to a range based on the found cells. Looping can also be used on columns (odd/even numbered) to set column widths

Hi there,

No, it's not a "homework" sorta thing. In fact, the company does a lot of tables as such called the Advertisement Expenditure. Thank u for ur suggestion :)

[fwawergurl16]

xld,

Thank u for helping me. I'll try it out & see. Thank u SO much! (this is what happens when a software eng. intern enters a media company! *faints*)

[p45cal]

..and for the headers something like:

Sub blah()
With Range("A4:A5,B4:C5,D4:E5,F4:G5,H4:I5,J4:K5,L4:M5,N4:O5,P4:Q5")
With .Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

With Range("B5:C5,D5:E5,F5:G5,H5:I5,J5:K5,L5:M5,N5:O5,P5:Q5").Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub

Other points, several of your other routines involve repetitive code, for example the mergeCells procedure can be shortened to:

Sub mergeCells()
With Range("D4:E4,F4:G4,H4:I4,J4:K4,L4:M4,N4:O4,P4:Q4,R4:S4,T4:U4,V4:W4,X4:Y4,Z4:AA4")
.ClearContents
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.mergeCells = True
End With
and if what you're doing with this procedure is ONLY merging cells it can go down to one line:

Sub mergeCells()
Range("D4:E4,F4:G4,H4:I4,J4:K4,L4:M4,N4:O4,P4:Q4,R4:S4,T4:U4,V4:W4,X4:Y4,Z4:AA4").mergeCells = True
End Sub