| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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." |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Copy/Insert rows | Excel Discussion (Misc queries) | |||
| Copy/Insert rows with formulas | Excel Worksheet Functions | |||
| Copy/Insert Rows Help needed | Excel Programming | |||
| Copy Rows and insert these rows before a page break | Excel Programming | |||
| Copy insert rows | Excel Programming | |||
Linear Mode
