Need to insert a row every time I get a text change in column c

[art69]

Column C as a code the same code may be in 5 to 50 rows before it changes I need to insert a row between the change and copy the columns A,C & F from the lower row on to the newly created row. This file as over 100,000 rows to go through.

Any help would be great.

 

[VeBeYay]

Hi,
This is a quick 'n dirty solution that I think does what you want. It assumes the first row of data is row 2.

Sub InsRows()

Dim iLstRow, i As Integer

iLstRow = Cells(Cells.Rows.Count, 3).End(xlUp).Row + 1
i = 3
Do While i < iLstRow
    If Cells(i, 3) <> Cells(i - 1, 3) Then
        Rows(i).Insert xlShiftDown
        Cells(i + 1, 1).Copy
        Cells(i, 1).PasteSpecial xlPasteAll
        Cells(i + 1, 3).Copy
        Cells(i, 3).PasteSpecial xlPasteAll
        Cells(i + 1, 6).Copy
        Cells(i, 6).PasteSpecial xlPasteAll
        Application.CutCopyMode = False
        i = i + 1
        iLstRow = iLstRow + 1
    End If
    i = i + 1
Loop

End Sub

 

[art69]

Hi,
This is a quick 'n dirty solution that I think does what you want. It assumes the first row of data is row 2.

Sub InsRows()

Dim iLstRow, i As Integer

iLstRow = Cells(Cells.Rows.Count, 3).End(xlUp).Row + 1
i = 3
Do While i < iLstRow
    If Cells(i, 3) <> Cells(i - 1, 3) Then
        Rows(i).Insert xlShiftDown
        Cells(i + 1, 1).Copy
        Cells(i, 1).PasteSpecial xlPasteAll
        Cells(i + 1, 3).Copy
        Cells(i, 3).PasteSpecial xlPasteAll
        Cells(i + 1, 6).Copy
        Cells(i, 6).PasteSpecial xlPasteAll
        Application.CutCopyMode = False
        i = i + 1
        iLstRow = iLstRow + 1
    End If
    i = i + 1
Loop

End Sub

Perfect helped me out big style thanks