Code debug

[Seeker]

Please help to debug following code which was collected and restructured
several codes from the discussion groups. I intended to add a thick black
bottom border to upper row if two rows contain different data, and then add a
blank row in between, now correct number of rows has formatted with a thick
black bottom border but all placed start from the last row up.

Expected result
AAAA
AAAA
AAAA 'thick bottom border
'Empty row in between
BBBB
BBBB 'thick bottom border
'Empty row in between
CCCC 'thick bottom border

Dim LastRow As Long
Dim lngRow As Long

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:X" & LastRow).Select

For lngRow = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
If Range("B" & lngRow) <> Range("B" & lngRow - 1) Then

Selection.Borders(xlEdgeTop).LineStyle = xlDot
Selection.Borders(xlEdgeTop).Weight = xlThin
Selection.Borders(xlEdgeTop).ColorIndex = 15

Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).Weight = xlThick
Selection.Borders(xlEdgeBottom).ColorIndex = 1

Selection.Borders(xlEdgeRight).LineStyle = xlDot
Selection.Borders(xlEdgeRight).Weight = xlThin
Selection.Borders(xlEdgeRight).ColorIndex = 15

Selection.Borders(xlInsideVertical).LineStyle = xlDot
Selection.Borders(xlInsideVertical).Weight = xlThin
Selection.Borders(xlInsideVertical).ColorIndex = 15

Selection.Borders(xlInsideHorizontal).LineStyle = xlDot
Selection.Borders(xlInsideHorizontal).Weight = xlThin
Selection.Borders(xlInsideHorizontal).ColorIndex = 15

Rows(lngRow).EntireRow.Insert
Else
Selection.Borders.LineStyle = xlDot
Selection.Borders.Weight = xlThin
Selection.Borders.ColorIndex = 15
End If
Rgds

 

[Jim Thomlinson]

Try this...

Dim LastRow As Long
Dim lngRow As Long

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:X" & LastRow).Select

For lngRow = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
If Range("B" & lngRow) <> Range("B" & lngRow - 1) Then
with range(cells(lngrow, "A"), Cells(lngrow, "X"))
.Borders(xlEdgeTop).LineStyle = xlDot
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeTop).ColorIndex = 15

.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlEdgeBottom).ColorIndex = 1

.Borders(xlEdgeRight).LineStyle = xlDot
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlEdgeRight).ColorIndex = 15

.Borders(xlInsideVertical).LineStyle = xlDot
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideVertical).ColorIndex = 15

.Borders(xlInsideHorizontal).LineStyle = xlDot
.Borders(xlInsideHorizontal).Weight = xlThin
.Borders(xlInsideHorizontal).ColorIndex = 15

Rows(lngRow).EntireRow.Insert
Else
.Borders.LineStyle = xlDot
.Borders.Weight = xlThin
.Borders.ColorIndex = 15
end with
End If

 

[Seeker]

Hi Jim,
Thanks for your reply, when I test your code, the compiler said "Else
without If"?
Rgds

 

[keiji kounoike]

this is a another approach.

Sub sometest()
Dim Lastcell As Range
Dim startcell As Range
Dim endcell As Range

Set Lastcell = Cells(Rows.Count, "A").End(xlUp)

Set startcell = Range("B2")
Set endcell = startcell.Cells(2, 1)

Do While (startcell.Row <= Lastcell.Row)

If startcell = endcell Then
Set endcell = endcell.Cells(2, 1)
Else
With Range(startcell.Cells(1, 0), endcell.Cells(0, 23))
If endcell.Row - startcell.Row > 1 Then
.Borders(xlInsideHorizontal).LineStyle = xlDot
.Borders(xlInsideHorizontal).Weight = xlThin
.Borders(xlInsideHorizontal).ColorIndex = 15
End If
.Borders(xlEdgeTop).LineStyle = xlDot
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeTop).ColorIndex = 15

.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlEdgeBottom).ColorIndex = 1

.Borders(xlEdgeRight).LineStyle = xlDot
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlEdgeRight).ColorIndex = 15

.Borders(xlInsideVertical).LineStyle = xlDot
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideVertical).ColorIndex = 15

End With
endcell(1, 1).EntireRow.Insert

Set startcell = endcell
Set endcell = startcell.Cells(2, 1)
End If
Loop
End Sub

Keiji

 

[Seeker]

keiji kounoike,
Your code works perfectly, million thanks.
Rgds

 

[keiji kounoike]

Thanks for your feedback.

Keiji

keiji kounoike,
Your code works perfectly, million thanks.
Rgds