Inbox for Column A

  • Thread starter Thread starter Stanley Braverman
  • Start date Start date
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
 
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
 
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))
 
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))
 
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
 
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
 
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.

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
Border formatting row of cells 22
using border/usedrange in vba 0
Mid column sum formulas with varied ranges to sum 17
Bug applying Borders to Range 1
Conditional Formatting macro: simple, but doesn't work 6
Multiple SUM's in a column 15
Borders Disappear When Hiding Columns 2

Back
Top