Inbox for Column A

S

Stanley Braverman

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.

Thanks
 
J

Joel

Sub Set_Borders()

LastRow = Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
If Range("A" & RowCount) <> "" Then

BorderLocation = InputBox("Enter Border Location for Row " & RowCount
& Chr(13) & _
"1= xlEdgeTop" & Chr(13) & _
"2= xlEdgeBottom")

Select Case BorderLocation
Case 1: BorderLoc = xlEdgeTop
Case 2: BorderLoc = xlEdgeBottom
End Select

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")

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" & Chr(13))

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
End Sub
 
S

Stanley Braverman

Thanks for the code. However there is a syntex error on the following .
They are displayed in red.


BorderLocation = InputBox("Enter Border Location for Row " & RowCount
& Chr(13) & _
"1= xlEdgeTop" & Chr(13) & _
"2= xlEdgeBottom")

And also on these

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))
 
J

Joel

The line got wrpped on two lines because it was longer that the box on the
post accepted

from
BorderLocation = InputBox("Enter Border Location for Row " & RowCount
& Chr(13) & _
"1= xlEdgeTop" & Chr(13) & _
"2= xlEdgeBottom")

to:

BorderLocation = InputBox("Enter Border Location for Row " & RowCount _
& Chr(13) & _
"1= xlEdgeTop" & Chr(13) & _
"2= xlEdgeBottom")

from
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))

to
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))
 
S

Stanley Braverman

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.

Thanks
 
J

JLGWhiz

Here is Joels code modified to allow the user to enter the border parameters
only one time for the entire column.

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")
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))
For RowCount = 1 To lastrow
If Range("A" & RowCount).Value <> "" Then
Select Case BorderLocation
Case 1: BorderLoc = xlEdgeTop
Case 2: BorderLoc = xlEdgeBottom
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
End Sub
 
J

JLGWhiz

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
 
J

Joel

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.

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")

Select Case BorderLocation
Case 1: BorderLoc = xlEdgeTop
Case 2: BorderLoc = xlEdgeBottom
End Select

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")

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA set thick borders around non empty cells in range 0
using border/usedrange in vba 0
Border formatting row of cells 22
Conditional Formatting macro: simple, but doesn't work 6
Bug applying Borders to Range 1
Mid column sum formulas with varied ranges to sum 17
Multiple SUM's in a column 15
Macro to add border 2

Top