ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Insert rows by group and copy value (https://www.excelbanter.com/excel-programming/443411-insert-rows-group-copy-value.html)

fzl2007
Insert rows by group and copy value
 
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
Insert rows by group and copy value
 
On Jul 26, 2:52*pm, fzl2007 wrote:
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
Insert rows by group and copy value
 
On Jul 26, 7:01*pm, Don Guillett Excel MVP
wrote:
On Jul 26, 2:52*pm, fzl2007 wrote:





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 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


All times are GMT +1. The time now is 08:09 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com