Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop not working!!
Can anyone help with the following.....I'm using Excel 2000, on Win2k
I've got 55000 row of data to sort, here's an example; Analysis Code Date Product Units 1A1 1-Nov-04 P02545 29 1A2 1-Nov-04 P02421 4 1Q2 1-Nov-04 P03400 11 1B 1-Nov-04 P09501 -1 Where Analysis Code is in Column A, Date in column B etc...... I need the macro to find each Analysis Code, copy the entire row, and paste it to a different worksheet in the workbook. So all the A1A into sheet 'A1A', 1A2 into Sheet '1A2' etc.......... I've written the following code, and it only works for the first With, E.G. it finds all '1A2', but the activates sheet '1A5' then stops without fining anything else!! I need to to loop through each analysis code (there are about 60). Sub datasort() Dim R As Integer, C As Integer R = 1 C = 1 Worksheets("Christmas0405").Select Range("A1").Select With Worksheets("Christmas0405").Range("a1:d65000") Set D = .Find("1A2") If Not D Is Nothing Then firstAddress = D.Address Do D.EntireRow.Copy Worksheets("1A2").Activate Range("a1").Select Do While Cells(R, C) < "" Cells(R, C).Activate R = R + 1 If Cells(R, C) = "" Then C = 1 Cells(R, C).PasteSpecial Paste:=xlValues Exit Do End If If R = 64536 Then MsgBox ("No blank rows") Exit Do End If Loop Set D = .FindNext(D) Loop While Not D Is Nothing And D.Address < firstAddress End If End With With Worksheets("Christmas0405").Range("a1:d65000") Set D = .Find("1A5") If Not D Is Nothing Then firstAddress = D.Address Do D.EntireRow.Copy Worksheets("1A5").Activate Range("a1").Select Do While Cells(R, C) < "" Cells(R, C).Activate R = R + 1 If Cells(R, C) = "" Then C = 1 Cells(R, C).PasteSpecial Paste:=xlValues Exit Do End If If R = 64536 Then MsgBox ("No blank rows") Exit Do End If Loop Set D = .FindNext(D) Loop While Not D Is Nothing And D.Address < firstAddress End If End With End Sub Many thanks in advance of your help!! Simon. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop not working!!
See Ron De Bruin's site where he has written a macro to do most of this:
http://www.rondebruin.nl/copy5.htm -- Regards, Tom Ogilvy "Simon" wrote in message ... Can anyone help with the following.....I'm using Excel 2000, on Win2k I've got 55000 row of data to sort, here's an example; Analysis Code Date Product Units 1A1 1-Nov-04 P02545 29 1A2 1-Nov-04 P02421 4 1Q2 1-Nov-04 P03400 11 1B 1-Nov-04 P09501 -1 Where Analysis Code is in Column A, Date in column B etc...... I need the macro to find each Analysis Code, copy the entire row, and paste it to a different worksheet in the workbook. So all the A1A into sheet 'A1A', 1A2 into Sheet '1A2' etc.......... I've written the following code, and it only works for the first With, E.G. it finds all '1A2', but the activates sheet '1A5' then stops without fining anything else!! I need to to loop through each analysis code (there are about 60). Sub datasort() Dim R As Integer, C As Integer R = 1 C = 1 Worksheets("Christmas0405").Select Range("A1").Select With Worksheets("Christmas0405").Range("a1:d65000") Set D = .Find("1A2") If Not D Is Nothing Then firstAddress = D.Address Do D.EntireRow.Copy Worksheets("1A2").Activate Range("a1").Select Do While Cells(R, C) < "" Cells(R, C).Activate R = R + 1 If Cells(R, C) = "" Then C = 1 Cells(R, C).PasteSpecial Paste:=xlValues Exit Do End If If R = 64536 Then MsgBox ("No blank rows") Exit Do End If Loop Set D = .FindNext(D) Loop While Not D Is Nothing And D.Address < firstAddress End If End With With Worksheets("Christmas0405").Range("a1:d65000") Set D = .Find("1A5") If Not D Is Nothing Then firstAddress = D.Address Do D.EntireRow.Copy Worksheets("1A5").Activate Range("a1").Select Do While Cells(R, C) < "" Cells(R, C).Activate R = R + 1 If Cells(R, C) = "" Then C = 1 Cells(R, C).PasteSpecial Paste:=xlValues Exit Do End If If R = 64536 Then MsgBox ("No blank rows") Exit Do End If Loop Set D = .FindNext(D) Loop While Not D Is Nothing And D.Address < firstAddress End If End With End Sub Many thanks in advance of your help!! Simon. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop not working!!
Hi, Tom. Good to see you. I sicnerely would appreciate some of your
expertise on a post I made four spots above this one, "formula help". This is an issue I just can't get resolved. You have always been very helpful, I hope you can help this time. Thanks in advance. "Tom Ogilvy" wrote: See Ron De Bruin's site where he has written a macro to do most of this: http://www.rondebruin.nl/copy5.htm -- Regards, Tom Ogilvy "Simon" wrote in message ... Can anyone help with the following.....I'm using Excel 2000, on Win2k I've got 55000 row of data to sort, here's an example; Analysis Code Date Product Units 1A1 1-Nov-04 P02545 29 1A2 1-Nov-04 P02421 4 1Q2 1-Nov-04 P03400 11 1B 1-Nov-04 P09501 -1 Where Analysis Code is in Column A, Date in column B etc...... I need the macro to find each Analysis Code, copy the entire row, and paste it to a different worksheet in the workbook. So all the A1A into sheet 'A1A', 1A2 into Sheet '1A2' etc.......... I've written the following code, and it only works for the first With, E.G. it finds all '1A2', but the activates sheet '1A5' then stops without fining anything else!! I need to to loop through each analysis code (there are about 60). Sub datasort() Dim R As Integer, C As Integer R = 1 C = 1 Worksheets("Christmas0405").Select Range("A1").Select With Worksheets("Christmas0405").Range("a1:d65000") Set D = .Find("1A2") If Not D Is Nothing Then firstAddress = D.Address Do D.EntireRow.Copy Worksheets("1A2").Activate Range("a1").Select Do While Cells(R, C) < "" Cells(R, C).Activate R = R + 1 If Cells(R, C) = "" Then C = 1 Cells(R, C).PasteSpecial Paste:=xlValues Exit Do End If If R = 64536 Then MsgBox ("No blank rows") Exit Do End If Loop Set D = .FindNext(D) Loop While Not D Is Nothing And D.Address < firstAddress End If End With With Worksheets("Christmas0405").Range("a1:d65000") Set D = .Find("1A5") If Not D Is Nothing Then firstAddress = D.Address Do D.EntireRow.Copy Worksheets("1A5").Activate Range("a1").Select Do While Cells(R, C) < "" Cells(R, C).Activate R = R + 1 If Cells(R, C) = "" Then C = 1 Cells(R, C).PasteSpecial Paste:=xlValues Exit Do End If If R = 64536 Then MsgBox ("No blank rows") Exit Do End If Loop Set D = .FindNext(D) Loop While Not D Is Nothing And D.Address < firstAddress End If End With End Sub Many thanks in advance of your help!! Simon. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Loop all Sheets not working. | New Users to Excel | |||
Do...Loop not working | Excel Programming | |||
for next loop not working | Excel Programming | |||
for next loop not working | Excel Programming | |||
Find value loop not working | Excel Programming |