keiji kounoike,
Your code works perfectly, million thanks.
Rgds
"keiji kounoike" <"kounoike AT mbh.nifty." wrote:
> 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 wrote:
> > 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
>
|
Similar Threads
