PDA

View Full Version : Macro Cell Borders



fwawergurl16
08-19-2007, 10:56 PM
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
08-20-2007, 12:30 AM
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
08-20-2007, 12:43 AM
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
08-20-2007, 01:09 AM
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
08-20-2007, 01:11 AM
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
08-20-2007, 02:17 AM
..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