I need a macro that will look at cells in column A and if not blank then
will allow me to format the cell(all cells that are not blank) with either a
top border or a bottom border with an inbox to select type of border.
Select Case LineSize
Case 1: LineSz = xlLineStyleNone
Case 2: LineSz = xlContinuous
Case 3: LineSz = xlDash
Case 4: LineSz = xlDashDot
Case 5: LineSz = xlDashDotDot
Case 6: LineSz = xlDot
Case 7: LineSz = xlDouble
Case 8: LineSz = xlSlantDashDot
Thanks Joel. That corrected the syntax errors. I am faced with the
following. I am getting requests for each next cell that is not blank and I
have to enter all the boxes again. As I have over 3000 or 4000 cells that
would have to be entered what I wanted was the inbox to set the
parameters(once) for all cells in coloum A and then do the rest
automatically as in a for next loop.
After some thought, maybe you would want to be able to remove the borders as
changes are made to the file and re-apply them. This version modifies Joel's
code to allow for the removal of all horizontal borders in column A by
selectin option 3 in the first input box.
Sub Set_Borders()
lastrow = Range("A" & Rows.Count).End(xlUp).Row
BorderLocation = InputBox("Enter Border Location for Row " _
& RowCount & Chr(13) & _
"1= xlEdgeTop" & Chr(13) & _
"2= xlEdgeBottom" & Chr(13) & _
"3= Delete Borders")
If BorderLocation <> "3" Then
LineSize = InputBox("Enter Line Style for Row " & RowCount & _
Chr(13) & _
"1= xlLineStyleNone" & Chr(13) & _
"2= xlContinuous" & Chr(13) & _
"3= xlDash" & Chr(13) & _
"4= xlDashDot" & Chr(13) & _
"5= xlDashDotDot" & Chr(13) & _
"6= xlDot" & Chr(13) & _
"7= xlDouble" & Chr(13) & _
"8= xlSlantDashDot")
LineThick = InputBox("Enter Line Thickness for Row " & RowCount _
& Chr(13) & _
"1= xlHairline" & Chr(13) & _
"2= xlMedium" & Chr(13) & _
"3= xlThick" & Chr(13) & _
"4= xlThin" & Chr(13))
End If
For RowCount = 1 To lastrow
If Range("A" & RowCount).Value <> "" Then
Select Case BorderLocation
Case 1: BorderLoc = xlEdgeTop
Case 2: BorderLoc = xlEdgeBottom
Case 3: GoTo Fini:
End Select
Select Case LineSize
Case 1: LineSz = xlLineStyleNone
Case 2: LineSz = xlContinuous
Case 3: LineSz = xlDash
Case 4: LineSz = xlDashDot
Case 5: LineSz = xlDashDotDot
Case 6: LineSz = xlDot
Case 7: LineSz = xlDouble
Case 8: LineSz = xlSlantDashDot
End Select
Select Case LineThick
Case 1: LineTh = xlHairline
Case 2: LineTh = xlMedium
Case 3: LineTh = xlThick
Case 4: LineTh = xlThin
End Select
With Range("A" & RowCount)
With .Borders(BorderLoc)
.LineStyle = LineSz
.Weight = LineTh
End With
End With
End If
Next RowCount
Fini:
If BorderLocation = 3 Then
Range("A1:A" & lastrow + 1).Borders(xlInsideHorizontal) _
.LineStyle = xlLineStyleNone
End If
End Sub
Stanley last code wasn't very efficient. It was executing a lot of code over
and over again that wasn't necessary. I also don't believe in GOTO
statements.
Select Case LineSize
Case 1: LineSz = xlLineStyleNone
Case 2: LineSz = xlContinuous
Case 3: LineSz = xlDash
Case 4: LineSz = xlDashDot
Case 5: LineSz = xlDashDotDot
Case 6: LineSz = xlDot
Case 7: LineSz = xlDouble
Case 8: LineSz = xlSlantDashDot
End Select
LineThick = InputBox("Enter Line Thickness for Row " & RowCount _
& Chr(13) & _
"1= xlHairline" & Chr(13) & _
"2= xlMedium" & Chr(13) & _
"3= xlThick" & Chr(13) & _
"4= xlThin")
End If
Select Case LineThick
Case 1: LineTh = xlHairline
Case 2: LineTh = xlMedium
Case 3: LineTh = xlThick
Case 4: LineTh = xlThin
End Select
If BorderLocation = 3 Then
Range("A1:A" & lastrow + 1).Borders(xlInsideHorizontal) _
.LineStyle = xlLineStyleNone
else
For RowCount = 1 To lastrow
If Range("A" & RowCount).Value <> "" Then
With Range("A" & RowCount)
With .Borders(BorderLoc)
.LineStyle = LineSz
.Weight = LineTh
End With
End With
End If
Next RowCount
End If
End Sub
