search for non empty cells in a collumn and put a border on top

[websqa]

Hi all,

I have no idea where to start. I need a macro that will search for non empty values in a column and when it finds any value put a border on top of that row. This is done to distingish between different records. So for example:

1. Record_One New_York
2.

Washington

3. Record_Two California
4.

New_Jersey

5. Record_Three Florida

If given this table the macro would run it will put a border on top of Rows 1, 3, 5 to distingish the different sets of states. Please help.

Thank You

[anilsolipuram]

I am considering that "A column" is the column where you want to search for blank cell and put borders.

try this macro

Sub Macro1()

Range("a1").Select
Dim i As Integer
i = 0
While i = 0

Selection.End(xlDown).Select
If ActiveCell.Row = 65536 Then
i = 1
Else
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
Wend
Range("a1").Select
End Sub

[websqa]

anilsolipuram,

Thank you very much! That's exactly what I needed. One question though, after this macro runs and it comes across three entires in Column A right after another, it will not put a border or the middle row. So for example:

Row A

Test1
Test2
Test3

Row Test2 won't be formatted with a border. Once again this is only when the macro comes across three rows in column A that have data in them one after another.

Thanks again for your help

[anilsolipuram]

Minor change in code

Sub Macro1()
Range("a1").Select
Dim i As Integer
i = 0
While i = 0
Selection.End(xlDown).Select
If ActiveCell.Row = 65536 Then
i = 1
Else
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
If ActiveCell.Offset(-1, 0).Value = "" Then
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
End If
Wend
Range("a1").Select
End Sub

[websqa]

Thanks a lot for trying to help but the revision of the code seems to now leave out the border not only if there are three records one after another in a column, but also if there are only two one after another. I guess I can always just run through it myself and check for missing borders. it's a 400 row spreadsheet that gets created biweekly so it shouldn't be too bad. Thanks again.

[anilsolipuram]

I misread your request.

hope this macro will solve your problem

Sub Macro1()
Range("a1").Select
Dim i As Integer
i = 0
Dim prev As Variant
Dim ne As Variant
Dim k As Variant
k = 1
While i = 0
prev = ActiveCell.Row
Selection.End(xlDown).Select
ne = ActiveCell.Row
If ActiveCell.Row = 65536 Then
i = 1
Else
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
If ActiveCell.Offset(-1, 0).Value = "" Then
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Else
Rows(prev & ":" & ne).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Range("B13").Select
Cells(ne, 1).Select
End If
End If
Wend
Range("a1").Select
End Sub