Insert rows by group and copy value

[fzl2007]

I want to insert two rows by every customerID. Leave one of the rows
blank. The first cell of other row should have the value of Column F,
the name of the customerID.

This is the original data
CustomerID A B C D Name
1102367 2 6500 0 58 ABC
1102367 5 6500 5 5 ABC
1102451 6 93165 8 48 XYZ
1102451 7 7 11 91 XYZ
1102451 5 3 14 134 XYZ
1102581 5 6 17 177 BBC
1102581 3 9 20 220 BBC
1102581 80 12 23 263 BBC
1103177 50 15 26 306 AAA
1103177 822154 18 29 349 AAA

Want to convert it to
CustomerID A B C D Name

ABC
1102367 2 6500 0 58 ABC
1102367 5 6500 5 5 ABC

XYZ
1102451 6 93165 8 48 XYZ
1102451 7 7 11 91 XYZ
1102451 5 3 14 134 XYZ

BBC
1102581 5 6 17 177 BBC
1102581 3 9 20 220 BBC
1102581 80 12 23 263 BBC

AAA
1103177 50 15 26 306 AAA
1103177 822154 18 29 349 AAA

I got the following code but it paste over the value

Sub test()

Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim botCell As Range
Dim topCell As Range
Dim wks As Worksheet


Set wks = ActiveSheet

With wks
.Columns(1).Delete

FirstRow = 2
.Rows(FirstRow).Insert
.Cells(FirstRow, "A").Value = ""
LastRow = .Cells(.Rows.Count, "A").End(xlUp).row

Set topCell = .Cells(LastRow, "A")
Set botCell = .Cells(LastRow, "A")
For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value
Then
Set topCell = .Cells(iRow - 1, "A")
Else
If topCell.Address = botCell.Address Then
'do nothing
Else
botCell.Offset(1, 0).EntireRow.Insert
botCell.Offset(1, 0).EntireRow.Insert

.Cells(iRow, "A").Value = .Cells(iRow + 1, "F")

End If
Set botCell = .Cells(iRow - 1, "A")
Set topCell = .Cells(iRow - 1, "A")
End If
Next iRow

End With


End Sub

I appreciate your help.

Faye

 

[Don Guillett Excel MVP]

I want to insert two rows by every customerID. Leave one of the rows
blank. The first cell of other row should have the value of Column F,
the name of the customerID.

This is the original data
CustomerID      A       B       C       D      Name
1102367 2       6500    0       58      ABC
1102367 5       6500    5       5       ABC
1102451 6       93165   8       48      XYZ
1102451 7       7       11      91      XYZ
1102451 5       3       14      134     XYZ
1102581 5       6       17      177     BBC
1102581 3       9       20      220     BBC
1102581 80      12      23      263     BBC
1103177 50      15      26      306     AAA
1103177 822154  18      29      349     AAA

Want to convert it to
CustomerID      A       B       C       D      Name

ABC
1102367 2       6500    0       58      ABC
1102367 5       6500    5       5       ABC

XYZ
1102451 6       93165   8       48      XYZ
1102451 7       7       11      91      XYZ
1102451 5       3       14      134     XYZ

BBC
1102581 5       6       17      177     BBC
1102581 3       9       20      220     BBC
1102581 80      12      23      263     BBC

AAA
1103177 50      15      26      306     AAA
1103177 822154  18      29      349     AAA

I got the following code but it paste over the value

Sub test()

    Dim FirstRow As Long
    Dim LastRow As Long
    Dim iRow As Long
    Dim botCell As Range
    Dim topCell As Range
    Dim wks As Worksheet

    Set wks = ActiveSheet

    With wks
  .Columns(1).Delete

        FirstRow = 2
        .Rows(FirstRow).Insert
        .Cells(FirstRow, "A").Value = ""
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).row

        Set topCell = .Cells(LastRow, "A")
        Set botCell = .Cells(LastRow, "A")
        For iRow = LastRow To FirstRow + 1 Step -1
            If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value
Then
                Set topCell = .Cells(iRow - 1, "A")
            Else
                If topCell.Address = botCell.Address Then
                    'do nothing
                Else
                    botCell.Offset(1, 0).EntireRow.Insert
                    botCell.Offset(1, 0).EntireRow.Insert

                    .Cells(iRow, "A").Value = .Cells(iRow + 1, "F")

                End If
                Set botCell = .Cells(iRow - 1, "A")
                Set topCell = .Cells(iRow - 1, "A")
            End If
        Next iRow

    End With

End Sub

I appreciate your help.

Faye

CustomerID A B C D Name
1102367 2 6500 0 58 ABC
1102367 5 6500 5 5 ABC
1102451 6 93165 8 48 XYZ
1102451 7 7 11 91 XYZ
1102451 5 3 14 134 XYZ
1102581 5 6 17 177 BBC
1102581 3 9 20 220 BBC
1102581 80 12 23 263 BBC
1103177 50 15 26 306 AAA
1103177 822154 18 29 349 AAA

CustomerID A B C D Name
1102367 2 6500 0 58 ABC
1102367 5 6500 5 5 ABC
1102451 6 93165 8 48 XYZ
1102451 7 7 11 91 XYZ
1102451 5 3 14 134 XYZ
1102581 5 6 17 177 BBC
1102581 3 9 20 220 BBC
1102581 80 12 23 263 BBC
1103177 50 15 26 306 AAA
1103177 822154 18 29 349 AAA

I couldn't easily get your data so
"If desired, send your file to dguillett @gmail.com I will only look
if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results."

 

[Don Guillett Excel MVP]

CustomerID      A       B       C       D      Name
1102367 2       6500    0       58      ABC
1102367 5       6500    5       5       ABC
1102451 6       93165   8       48      XYZ
1102451 7       7       11      91      XYZ
1102451 5       3       14      134     XYZ
1102581 5       6       17      177     BBC
1102581 3       9       20      220     BBC
1102581 80      12      23      263     BBC
1103177 50      15      26      306     AAA
1103177 822154  18      29      349     AAA

CustomerID      A       B       C       D      Name
1102367 2       6500    0       58      ABC
1102367 5       6500    5       5       ABC
1102451 6       93165   8       48      XYZ
1102451 7       7       11      91      XYZ
1102451 5       3       14      134     XYZ
1102581 5       6       17      177     BBC
1102581 3       9       20      220     BBC
1102581 80      12      23      263     BBC
1103177 50      15      26      306     AAA
1103177 822154  18      29      349     AAA

I couldn't easily get your data so
"If desired, send your file to dguillett  @gmail.com I will only look
if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results."- Hide quoted text -

- Show quoted text -

This should do it

Option Explicit
Sub RearrageDataSAS()
Application.ScreenUpdating = False
Dim i As Long

For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
'=======
If Cells(i - 1, 1) <> Cells(i, 1) And Len(Cells(i - 1, 1)) > 1 Then
'MsgBox Cells(i, 1)
Rows(i).Resize(2).Insert
Cells(i + 1, 1) = Cells(i + 2, 6)
End If
'=======
Next i
Application.ScreenUpdating = True
End Sub