Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Do loop until, step down row - copy paste - not what it seems.
Sorry for the title and the code attached,
Basically I have reached that stretch where I do not have enough skill or experience to get a program to work. Two sheets. The row on sheet (3) must increase with each loop. The row on sheet (2) checks for a match in value with sheet (3) If found the 3 cells on sheet (3) are copied and pasted into sheet (2). The row on sheet (2) increases as the row in sheet (3) does at the next loop. The loop keeps going until the last row that may have information is reached on sheet(3). Dim i As Integer 'horizontal row step count Dim j As Integer 'tracking sheet move down one Dim k As Integer 'summary sheet move down one row after saving pasted info. 'Match the code on row4 (Sheet 3) Range Horizontal (A4 : HQ4) 'with the code on trackingsheet (Sheet2) Vertical Range (A59 : A209) 'when they match, then take the offset Horizontal range value and copy it to the 'correct horizontal cells vertically offset in the Range on summary 'drop down a row for pasting too for next loop for value in sheet (2) 'loop until finished. Dim rng1 As Range Dim rng2 As Range Dim rng3 As Range Dim rng4 As Range Dim rng5 As Range Dim rng6 As Range Dim rng7 As Range Dim rng8 As Range Dim rng9 As Range Dim rng10 As Range Dim rng11 As Range Dim cell As Range Dim res As Variant Dim z As Variant 'sheet 2 tracking sheet 'set up counter and limits j = 58 Sheet2.Visible = True Do Set rng2 = Sheet2.Range(Cells(j, 1)) 'row and column 'set up the search For Each cell In rng1 'sheet 3 is where rng1 is found Sheet3.Visible = True 'summary sheet(3) k = 55 'starting row for copying too, on summary sheet Set rng1 = Sheet3.Range("A4:HQ4") 'row and column res = "" 'res = some string on sheet(2) in column 1 res = Application.WorksheetFunction.Match(cell.Value, rng2, 0) ' match string on sheet 2 with something on sht 3 If Not IsError(res) Then ' they match ' do something like start copying cell information z = "" 'basically z = res z = cell.Value 'set object from Match function Rem MsgBox cell.Value ' placed for debugging when it works to this line 'copy cells from tracking sheet2 , there are 3 cells Sheet2.Visible = True Set rng3 = Sheet2.Range("A4:HQ4").Find(what:=z, LookIn:=xlValues) 'find the value in sht2 which is res Set rng4 = rng3.Offset(0, 17) '0 cells (row)down 17 cells (column) across is the offset to column Q Set rng5 = rng3.Offset(0, 22) '0 cells (row)down 22 cells (column) across is the offset to column V Set rng6 = rng3.Offset(0, 21) '0 cells (row)down 21 cells (column) across is the offset to column U 'paste into summary sht3 Set rng7 = Sheets("table").Range(Cells(4, i)).Find(what:=z, LookIn:=xlValues) 'find the correct cell Set rng8 = rng7.Offset(k, 0) ' "k" cells down (row) 0 cells across (column) is the offset rng4.Copy Destination:=Sheet3.Range(rng8.Address) 'copy the value Q rng9 = rng8.Offset(0, 5) rng5.Copy: Sheet3.Range(rng9.Address).PasteSpecial 'copy the value V rng10 = rng8.Offset(0, 4) rng6.Copy: Sheet3.Range(rng10.Address).PasteSpecial 'copy the value U k = k + 1 'paste completed, go down one row for next cycle Else ' they don't match End If ' continue Next Loop Until j = 209 ' next row down for sheet 3 tracking Any suggestions where I'm going wrong???? or push shove , kick, in the right direction. If I can get this to work an xls sheet of 11meg with if and do's in each cell will be ruduced to say 353K before information is pasted to sheet(3) for the thing to work. Hope springs eternal - it is Xmas. Thanks in advance for your assistance. -- Regards Bill |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
copy paste loop---new to vba | Excel Programming | |||
Copy and Paste using a loop | Excel Programming | |||
Copy and Paste Loop | Excel Programming | |||
Copy/Paste Loop | Excel Programming | |||
copy and paste loop | Excel Programming |