| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
loops ...
Some help please. I have a workbook with 2 worksheets sheet 1 a b c d e 1 3/12/2004 3 500 25 543 2 3/13/2004 3 501 26 544 3 3/17/2004 4 505 30 548 4 3/18/2004 5 506 31 549 5 3/18/2004 5 506 31 549 6 3/19/2004 6 507 32 550 7 3/20/2004 7 508 33 551 sheet 2 a b c c 1 3/12/2025 3 6000 4 2 3/12/2025 4 8000 3 3 3/12/2025 5 20000 1 4 3/12/2025 6 50000 3 5 3/12/2025 7 23000 4 What I am attempting to do is for every instance in sheet 1 where the value in column b is equal to the value in sheet 2 column b to copy and insert the range in sheet 1 as many times as the value in sheet 2 column c. for instance sheet 1 row 2 will be copied and inserted 4 times, row 2 - 4 times row 3 - 3 times, row 5 not copied The result should look like 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/17/2004 4 505 30 548 3/17/2004 4 505 30 548 3/17/2004 4 505 30 548 3/17/2004 4 505 30 548 I have attempted the following which does not work so I am looking for any help/suggestions Dim cell As Range, i As Integer, cell1 As Range, j As Integer Set cell = ActiveWorkbook.Worksheets("Sheet2").Cells(2, 2) Set cell1 = ActiveWorkbook.Worksheets("Sheet1").Cells(2, 2) i = cell.Offset(0, 2) Do Until IsEmpty(cell.Value) Do While cell = cell1 If cell 1 Then For j = 1 To i Range(cell1.Offset(0, -1), cell1.Offset(0, 3)).Select Selection.Copy Selection.Insert Shift:=xlDown Next j Application.CutCopyMode = False End If Set cell = cell.Offset(1, 0) Loop Set cell1 = cell1.Offset(1, 0) Loop -- thanks as always for the help jer |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
loops ...
Sub ABC()
Dim cell As Range, i As Long, cell1 As Range Dim lastrow As Long, sh1 As Worksheet Set cell = ActiveWorkbook.Worksheets("Sheet2").Cells(1, 2) Set sh1 = ActiveWorkbook.Worksheets("Sheet1") Do Until IsEmpty(cell.Value) lastrow = sh1.Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 Set cell1 = sh1.Cells(i, 2) If cell1 = cell And cell.Offset(0, 2) 1 Then cell1.Offset(1, 0).Resize(cell.Offset(0, 2) _ , 1).EntireRow.Insert cell1.Offset(0, -1).Resize(1, 5).Copy _ cell1.Offset(1, -1).Resize(cell.Offset(0, 2), 5) End If Next i Set cell = cell.Offset(1, 0) Loop End Sub -- Regards, Tom Ogilvy "jer" wrote in message ... Some help please. I have a workbook with 2 worksheets sheet 1 a b c d e 1 3/12/2004 3 500 25 543 2 3/13/2004 3 501 26 544 3 3/17/2004 4 505 30 548 4 3/18/2004 5 506 31 549 5 3/18/2004 5 506 31 549 6 3/19/2004 6 507 32 550 7 3/20/2004 7 508 33 551 sheet 2 a b c c 1 3/12/2025 3 6000 4 2 3/12/2025 4 8000 3 3 3/12/2025 5 20000 1 4 3/12/2025 6 50000 3 5 3/12/2025 7 23000 4 What I am attempting to do is for every instance in sheet 1 where the value in column b is equal to the value in sheet 2 column b to copy and insert the range in sheet 1 as many times as the value in sheet 2 column c. for instance sheet 1 row 2 will be copied and inserted 4 times, row 2 - 4 times row 3 - 3 times, row 5 not copied The result should look like 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/17/2004 4 505 30 548 3/17/2004 4 505 30 548 3/17/2004 4 505 30 548 3/17/2004 4 505 30 548 I have attempted the following which does not work so I am looking for any help/suggestions Dim cell As Range, i As Integer, cell1 As Range, j As Integer Set cell = ActiveWorkbook.Worksheets("Sheet2").Cells(2, 2) Set cell1 = ActiveWorkbook.Worksheets("Sheet1").Cells(2, 2) i = cell.Offset(0, 2) Do Until IsEmpty(cell.Value) Do While cell = cell1 If cell 1 Then For j = 1 To i Range(cell1.Offset(0, -1), cell1.Offset(0, 3)).Select Selection.Copy Selection.Insert Shift:=xlDown Next j Application.CutCopyMode = False End If Set cell = cell.Offset(1, 0) Loop Set cell1 = cell1.Offset(1, 0) Loop -- thanks as always for the help jer |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
loops ...
Sub Test()
Dim cLastRow As Long Dim i As Long Dim irow As Long Dim ws As Worksheet cLastRow = Cells(Rows.Count, "A").End(xlUp).Row Set ws = Worksheets("Sheet2") For i = cLastRow To 1 Step -1 With Worksheets("Sheet1") On Error Resume Next irow = Application.Match(.Cells(i, "B").Value, _ ws.Range("B:B"), 0) On Error GoTo 0 If irow 0 Then If ws.Cells(irow, "D").Value 1 Then .Cells(i + 1, 1).Resize(ws.Cells(irow, "D").Value - 1) _ .EntireRow.Insert .Cells(i, 1).EntireRow.Copy Destination:= _ .Cells(i, 1).Resize(ws.Cells(irow, "D").Value) End If End If End With Next i End Sub -- HTH RP (remove nothere from the email address if mailing direct) "jer" wrote in message ... Some help please. I have a workbook with 2 worksheets sheet 1 a b c d e 1 3/12/2004 3 500 25 543 2 3/13/2004 3 501 26 544 3 3/17/2004 4 505 30 548 4 3/18/2004 5 506 31 549 5 3/18/2004 5 506 31 549 6 3/19/2004 6 507 32 550 7 3/20/2004 7 508 33 551 sheet 2 a b c c 1 3/12/2025 3 6000 4 2 3/12/2025 4 8000 3 3 3/12/2025 5 20000 1 4 3/12/2025 6 50000 3 5 3/12/2025 7 23000 4 What I am attempting to do is for every instance in sheet 1 where the value in column b is equal to the value in sheet 2 column b to copy and insert the range in sheet 1 as many times as the value in sheet 2 column c. for instance sheet 1 row 2 will be copied and inserted 4 times, row 2 - 4 times row 3 - 3 times, row 5 not copied The result should look like 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/17/2004 4 505 30 548 3/17/2004 4 505 30 548 3/17/2004 4 505 30 548 3/17/2004 4 505 30 548 I have attempted the following which does not work so I am looking for any help/suggestions Dim cell As Range, i As Integer, cell1 As Range, j As Integer Set cell = ActiveWorkbook.Worksheets("Sheet2").Cells(2, 2) Set cell1 = ActiveWorkbook.Worksheets("Sheet1").Cells(2, 2) i = cell.Offset(0, 2) Do Until IsEmpty(cell.Value) Do While cell = cell1 If cell 1 Then For j = 1 To i Range(cell1.Offset(0, -1), cell1.Offset(0, 3)).Select Selection.Copy Selection.Insert Shift:=xlDown Next j Application.CutCopyMode = False End If Set cell = cell.Offset(1, 0) Loop Set cell1 = cell1.Offset(1, 0) Loop -- thanks as always for the help jer |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
loops ...
Bob, not to be out done works just as well thank you very much
jer "Bob Phillips" wrote: Sub Test() Dim cLastRow As Long Dim i As Long Dim irow As Long Dim ws As Worksheet cLastRow = Cells(Rows.Count, "A").End(xlUp).Row Set ws = Worksheets("Sheet2") For i = cLastRow To 1 Step -1 With Worksheets("Sheet1") On Error Resume Next irow = Application.Match(.Cells(i, "B").Value, _ ws.Range("B:B"), 0) On Error GoTo 0 If irow 0 Then If ws.Cells(irow, "D").Value 1 Then .Cells(i + 1, 1).Resize(ws.Cells(irow, "D").Value - 1) _ .EntireRow.Insert .Cells(i, 1).EntireRow.Copy Destination:= _ .Cells(i, 1).Resize(ws.Cells(irow, "D").Value) End If End If End With Next i End Sub -- HTH RP (remove nothere from the email address if mailing direct) "jer" wrote in message ... Some help please. I have a workbook with 2 worksheets sheet 1 a b c d e 1 3/12/2004 3 500 25 543 2 3/13/2004 3 501 26 544 3 3/17/2004 4 505 30 548 4 3/18/2004 5 506 31 549 5 3/18/2004 5 506 31 549 6 3/19/2004 6 507 32 550 7 3/20/2004 7 508 33 551 sheet 2 a b c c 1 3/12/2025 3 6000 4 2 3/12/2025 4 8000 3 3 3/12/2025 5 20000 1 4 3/12/2025 6 50000 3 5 3/12/2025 7 23000 4 What I am attempting to do is for every instance in sheet 1 where the value in column b is equal to the value in sheet 2 column b to copy and insert the range in sheet 1 as many times as the value in sheet 2 column c. for instance sheet 1 row 2 will be copied and inserted 4 times, row 2 - 4 times row 3 - 3 times, row 5 not copied The result should look like 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/17/2004 4 505 30 548 3/17/2004 4 505 30 548 3/17/2004 4 505 30 548 3/17/2004 4 505 30 548 I have attempted the following which does not work so I am looking for any help/suggestions Dim cell As Range, i As Integer, cell1 As Range, j As Integer Set cell = ActiveWorkbook.Worksheets("Sheet2").Cells(2, 2) Set cell1 = ActiveWorkbook.Worksheets("Sheet1").Cells(2, 2) i = cell.Offset(0, 2) Do Until IsEmpty(cell.Value) Do While cell = cell1 If cell 1 Then For j = 1 To i Range(cell1.Offset(0, -1), cell1.Offset(0, 3)).Select Selection.Copy Selection.Insert Shift:=xlDown Next j Application.CutCopyMode = False End If Set cell = cell.Offset(1, 0) Loop Set cell1 = cell1.Offset(1, 0) Loop -- thanks as always for the help jer |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
loops ...
Tom, Thank you very much works like a charm
jer "Tom Ogilvy" wrote: Sub ABC() Dim cell As Range, i As Long, cell1 As Range Dim lastrow As Long, sh1 As Worksheet Set cell = ActiveWorkbook.Worksheets("Sheet2").Cells(1, 2) Set sh1 = ActiveWorkbook.Worksheets("Sheet1") Do Until IsEmpty(cell.Value) lastrow = sh1.Cells(Rows.Count, 2).End(xlUp).Row For i = lastrow To 1 Step -1 Set cell1 = sh1.Cells(i, 2) If cell1 = cell And cell.Offset(0, 2) 1 Then cell1.Offset(1, 0).Resize(cell.Offset(0, 2) _ , 1).EntireRow.Insert cell1.Offset(0, -1).Resize(1, 5).Copy _ cell1.Offset(1, -1).Resize(cell.Offset(0, 2), 5) End If Next i Set cell = cell.Offset(1, 0) Loop End Sub -- Regards, Tom Ogilvy "jer" wrote in message ... Some help please. I have a workbook with 2 worksheets sheet 1 a b c d e 1 3/12/2004 3 500 25 543 2 3/13/2004 3 501 26 544 3 3/17/2004 4 505 30 548 4 3/18/2004 5 506 31 549 5 3/18/2004 5 506 31 549 6 3/19/2004 6 507 32 550 7 3/20/2004 7 508 33 551 sheet 2 a b c c 1 3/12/2025 3 6000 4 2 3/12/2025 4 8000 3 3 3/12/2025 5 20000 1 4 3/12/2025 6 50000 3 5 3/12/2025 7 23000 4 What I am attempting to do is for every instance in sheet 1 where the value in column b is equal to the value in sheet 2 column b to copy and insert the range in sheet 1 as many times as the value in sheet 2 column c. for instance sheet 1 row 2 will be copied and inserted 4 times, row 2 - 4 times row 3 - 3 times, row 5 not copied The result should look like 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/12/2004 3 500 25 543 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/13/2004 3 501 26 544 3/17/2004 4 505 30 548 3/17/2004 4 505 30 548 3/17/2004 4 505 30 548 3/17/2004 4 505 30 548 I have attempted the following which does not work so I am looking for any help/suggestions Dim cell As Range, i As Integer, cell1 As Range, j As Integer Set cell = ActiveWorkbook.Worksheets("Sheet2").Cells(2, 2) Set cell1 = ActiveWorkbook.Worksheets("Sheet1").Cells(2, 2) i = cell.Offset(0, 2) Do Until IsEmpty(cell.Value) Do While cell = cell1 If cell 1 Then For j = 1 To i Range(cell1.Offset(0, -1), cell1.Offset(0, 3)).Select Selection.Copy Selection.Insert Shift:=xlDown Next j Application.CutCopyMode = False End If Set cell = cell.Offset(1, 0) Loop Set cell1 = cell1.Offset(1, 0) Loop -- thanks as always for the help jer |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| loops???? | Excel Worksheet Functions | |||
| Loops | Excel Discussion (Misc queries) | |||
| Using For - Next Loops in VB | New Users to Excel | |||
| Loops | Excel Programming | |||
| Loops etc. | Excel Programming | |||
Linear Mode
