| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Quicker Counting
A 2-part question. I have code that will sort a a dataset (with multiple
rows and columns) by the data in column "J" (a STATE field). Then, the code will cycle through the sorted list and everytime a state changes, new lines will be entered to the next 1,000th (so if 'AK' has 700 rows, 300 blank lines will be entered before the 'AL' rows (which will start on row 1001; if 'AK' has 1100 rows, 900 blank lines willbe entered before the 'AL' rows (which will start on row 2001, etc). The code works, but not as fast as I would like to see. Does anyone have any suggestions for a faster way? Sub Test() Cells.Select Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'go to the State column, row 2 Application.Goto reference:="R2C10" PrevCell = ActiveCell.Value RowNum = 1 Do Until PrevCell = "" 'find the next state Do Until ActiveCell.Value < PrevCell Application.Goto reference:="R" & RowNum + 1 & "C10" RowNum = RowNum + 1 Loop 'find the next 1000th line NewRow = Application.WorksheetFunction.Ceiling(RowNum, 1000) 'do until the next 1000th line Do While RowNum <= NewRow Rows(RowNum).Select 'select the row Selection.Insert Shift:=xlDown 'insert blank line RowNum = RowNum + 1 'go to next row Loop 'move 1 row down and column J Application.Goto reference:="R" & NewRow + 1 & "C10" PrevCell = ActiveCell.Value Loop End Sub Thanks in advance for any/all suggestions. |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quicker Counting
I would probably do it differently, but the following should speed up your existing code. It is untested and the row values may need adjusting up or down by 1. -- Jim Cone San Francisco, USA http://www.realezsites.com/bus/primitivesoftware (Excel Add-ins / Excel Programming) '------------- Sub Test() Dim PrevCell As Variant Dim RowNum As Long Dim NewRow As Long Cells.Sort Key1:=Range("J2"), Order1:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom, DataOption1:=xlSortNormal 'go to the State column, row 2 Application.Goto reference:="R2C10" PrevCell = ActiveCell.Value Do Until PrevCell = "" 'find the next state Do Until ActiveCell.Value < PrevCell ActiveCell.Offset(1, 0).Select Loop RowNum = ActiveCell.Row 'find the next 1000th line NewRow = Application.WorksheetFunction.Ceiling(RowNum, 1000) 'do until the next 1000th line Do While RowNum <= NewRow Rows(RowNum).Insert Shift:=xlDown RowNum = RowNum + 1 'go to Next Row Loop 'move 1 row down and column J Cells(NewRow + 1, 10).Select PrevCell = ActiveCell.Value Loop End Sub '----------- "ReportSmith" wrote in message A 2-part question. I have code that will sort a a dataset (with multiple rows and columns) by the data in column "J" (a STATE field). Then, the code will cycle through the sorted list and everytime a state changes, new lines will be entered to the next 1,000th (so if 'AK' has 700 rows, 300 blank lines will be entered before the 'AL' rows (which will start on row 1001; if 'AK' has 1100 rows, 900 blank lines willbe entered before the 'AL' rows (which will start on row 2001, etc). The code works, but not as fast as I would like to see. Does anyone have any suggestions for a faster way? Sub Test() Cells.Select Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'go to the State column, row 2 Application.Goto reference:="R2C10" PrevCell = ActiveCell.Value RowNum = 1 Do Until PrevCell = "" 'find the next state Do Until ActiveCell.Value < PrevCell Application.Goto reference:="R" & RowNum + 1 & "C10" RowNum = RowNum + 1 Loop 'find the next 1000th line NewRow = Application.WorksheetFunction.Ceiling(RowNum, 1000) 'do until the next 1000th line Do While RowNum <= NewRow Rows(RowNum).Select 'select the row Selection.Insert Shift:=xlDown 'insert blank line RowNum = RowNum + 1 'go to next row Loop 'move 1 row down and column J Application.Goto reference:="R" & NewRow + 1 & "C10" PrevCell = ActiveCell.Value Loop End Sub Thanks in advance for any/all suggestions. |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quicker Counting
This should be close...
Sub test() Dim rng As Range Dim lng As Long Set rng = Cells(Rows.Count, "J").End(xlUp) Range(rng, Range("J2")).Sort Key1:=Range("J2"), Order1:=xlAscending, _ Header:=xlNo Set rng = Cells(Rows.Count, "J").End(xlUp) lng = 0 Do While rng.Row 2 Set rng = rng.Offset(-1, 0) If rng.Value < rng.Offset(1, 0).Value Then Do While rng.Value = rng.Offset(-lng) lng = lng + 1 Loop rng.Offset(1, 0).Resize(1000 - lng).EntireRow.Insert lng = 0 End If Loop rng.End(xlDown).Offset(1, 0).EntireRow.Delete End Sub -- HTH... Jim Thomlinson "ReportSmith" wrote: A 2-part question. I have code that will sort a a dataset (with multiple rows and columns) by the data in column "J" (a STATE field). Then, the code will cycle through the sorted list and everytime a state changes, new lines will be entered to the next 1,000th (so if 'AK' has 700 rows, 300 blank lines will be entered before the 'AL' rows (which will start on row 1001; if 'AK' has 1100 rows, 900 blank lines willbe entered before the 'AL' rows (which will start on row 2001, etc). The code works, but not as fast as I would like to see. Does anyone have any suggestions for a faster way? Sub Test() Cells.Select Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'go to the State column, row 2 Application.Goto reference:="R2C10" PrevCell = ActiveCell.Value RowNum = 1 Do Until PrevCell = "" 'find the next state Do Until ActiveCell.Value < PrevCell Application.Goto reference:="R" & RowNum + 1 & "C10" RowNum = RowNum + 1 Loop 'find the next 1000th line NewRow = Application.WorksheetFunction.Ceiling(RowNum, 1000) 'do until the next 1000th line Do While RowNum <= NewRow Rows(RowNum).Select 'select the row Selection.Insert Shift:=xlDown 'insert blank line RowNum = RowNum + 1 'go to next row Loop 'move 1 row down and column J Application.Goto reference:="R" & NewRow + 1 & "C10" PrevCell = ActiveCell.Value Loop End Sub Thanks in advance for any/all suggestions. |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quicker Counting
Ooops... I just noticed mine is only sorting column J... Try this...
Sub test() Dim rng As Range Dim lng As Long Set rng = Cells(Rows.Count, "J").End(xlUp) Range(rng, Range("J2")).EntireRow.Sort Key1:=Range("J2"), Order1:=xlAscending, _ Header:=xlNo Set rng = Cells(Rows.Count, "J").End(xlUp) lng = 0 Do While rng.Row 2 Set rng = rng.Offset(-1, 0) If rng.Value < rng.Offset(1, 0).Value Then Do While rng.Value = rng.Offset(-lng) lng = lng + 1 Loop rng.Offset(1, 0).Resize(20 - lng).EntireRow.Insert lng = 0 End If Loop rng.End(xlDown).Offset(1, 0).EntireRow.Delete End Sub -- HTH... Jim Thomlinson "Jim Thomlinson" wrote: This should be close... Sub test() Dim rng As Range Dim lng As Long Set rng = Cells(Rows.Count, "J").End(xlUp) Range(rng, Range("J2")).Sort Key1:=Range("J2"), Order1:=xlAscending, _ Header:=xlNo Set rng = Cells(Rows.Count, "J").End(xlUp) lng = 0 Do While rng.Row 2 Set rng = rng.Offset(-1, 0) If rng.Value < rng.Offset(1, 0).Value Then Do While rng.Value = rng.Offset(-lng) lng = lng + 1 Loop rng.Offset(1, 0).Resize(1000 - lng).EntireRow.Insert lng = 0 End If Loop rng.End(xlDown).Offset(1, 0).EntireRow.Delete End Sub -- HTH... Jim Thomlinson "ReportSmith" wrote: A 2-part question. I have code that will sort a a dataset (with multiple rows and columns) by the data in column "J" (a STATE field). Then, the code will cycle through the sorted list and everytime a state changes, new lines will be entered to the next 1,000th (so if 'AK' has 700 rows, 300 blank lines will be entered before the 'AL' rows (which will start on row 1001; if 'AK' has 1100 rows, 900 blank lines willbe entered before the 'AL' rows (which will start on row 2001, etc). The code works, but not as fast as I would like to see. Does anyone have any suggestions for a faster way? Sub Test() Cells.Select Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'go to the State column, row 2 Application.Goto reference:="R2C10" PrevCell = ActiveCell.Value RowNum = 1 Do Until PrevCell = "" 'find the next state Do Until ActiveCell.Value < PrevCell Application.Goto reference:="R" & RowNum + 1 & "C10" RowNum = RowNum + 1 Loop 'find the next 1000th line NewRow = Application.WorksheetFunction.Ceiling(RowNum, 1000) 'do until the next 1000th line Do While RowNum <= NewRow Rows(RowNum).Select 'select the row Selection.Insert Shift:=xlDown 'insert blank line RowNum = RowNum + 1 'go to next row Loop 'move 1 row down and column J Application.Goto reference:="R" & NewRow + 1 & "C10" PrevCell = ActiveCell.Value Loop End Sub Thanks in advance for any/all suggestions. |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quicker Counting
Thanks for the suggestions. I will try them out as time allows (as always,
time is of the essence). In the meantime, I will go with the code I have. Thanks again. "Jim Thomlinson" wrote: Ooops... I just noticed mine is only sorting column J... Try this... Sub test() Dim rng As Range Dim lng As Long Set rng = Cells(Rows.Count, "J").End(xlUp) Range(rng, Range("J2")).EntireRow.Sort Key1:=Range("J2"), Order1:=xlAscending, _ Header:=xlNo Set rng = Cells(Rows.Count, "J").End(xlUp) lng = 0 Do While rng.Row 2 Set rng = rng.Offset(-1, 0) If rng.Value < rng.Offset(1, 0).Value Then Do While rng.Value = rng.Offset(-lng) lng = lng + 1 Loop rng.Offset(1, 0).Resize(20 - lng).EntireRow.Insert lng = 0 End If Loop rng.End(xlDown).Offset(1, 0).EntireRow.Delete End Sub -- HTH... Jim Thomlinson "Jim Thomlinson" wrote: This should be close... Sub test() Dim rng As Range Dim lng As Long Set rng = Cells(Rows.Count, "J").End(xlUp) Range(rng, Range("J2")).Sort Key1:=Range("J2"), Order1:=xlAscending, _ Header:=xlNo Set rng = Cells(Rows.Count, "J").End(xlUp) lng = 0 Do While rng.Row 2 Set rng = rng.Offset(-1, 0) If rng.Value < rng.Offset(1, 0).Value Then Do While rng.Value = rng.Offset(-lng) lng = lng + 1 Loop rng.Offset(1, 0).Resize(1000 - lng).EntireRow.Insert lng = 0 End If Loop rng.End(xlDown).Offset(1, 0).EntireRow.Delete End Sub -- HTH... Jim Thomlinson "ReportSmith" wrote: A 2-part question. I have code that will sort a a dataset (with multiple rows and columns) by the data in column "J" (a STATE field). Then, the code will cycle through the sorted list and everytime a state changes, new lines will be entered to the next 1,000th (so if 'AK' has 700 rows, 300 blank lines will be entered before the 'AL' rows (which will start on row 1001; if 'AK' has 1100 rows, 900 blank lines willbe entered before the 'AL' rows (which will start on row 2001, etc). The code works, but not as fast as I would like to see. Does anyone have any suggestions for a faster way? Sub Test() Cells.Select Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'go to the State column, row 2 Application.Goto reference:="R2C10" PrevCell = ActiveCell.Value RowNum = 1 Do Until PrevCell = "" 'find the next state Do Until ActiveCell.Value < PrevCell Application.Goto reference:="R" & RowNum + 1 & "C10" RowNum = RowNum + 1 Loop 'find the next 1000th line NewRow = Application.WorksheetFunction.Ceiling(RowNum, 1000) 'do until the next 1000th line Do While RowNum <= NewRow Rows(RowNum).Select 'select the row Selection.Insert Shift:=xlDown 'insert blank line RowNum = RowNum + 1 'go to next row Loop 'move 1 row down and column J Application.Goto reference:="R" & NewRow + 1 & "C10" PrevCell = ActiveCell.Value Loop End Sub Thanks in advance for any/all suggestions. |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quicker Counting
This is not directed solely at you but I feel the need to vent a bit. If
there are parameters such as you only want minor tweaks to your existing code and are not interested in other solutions then please specify that ahead of time. When you do not even take the time to test my solution, you have completely wasted my time. When you waste the time of people who are providing the solutions it does not bode well for getting help in the future. If someone has taken the considerable time to provide a solution the least you can do is to test it and give them some feedback. -- HTH... Jim Thomlinson "ReportSmith" wrote: Thanks for the suggestions. I will try them out as time allows (as always, time is of the essence). In the meantime, I will go with the code I have. Thanks again. "Jim Thomlinson" wrote: Ooops... I just noticed mine is only sorting column J... Try this... Sub test() Dim rng As Range Dim lng As Long Set rng = Cells(Rows.Count, "J").End(xlUp) Range(rng, Range("J2")).EntireRow.Sort Key1:=Range("J2"), Order1:=xlAscending, _ Header:=xlNo Set rng = Cells(Rows.Count, "J").End(xlUp) lng = 0 Do While rng.Row 2 Set rng = rng.Offset(-1, 0) If rng.Value < rng.Offset(1, 0).Value Then Do While rng.Value = rng.Offset(-lng) lng = lng + 1 Loop rng.Offset(1, 0).Resize(20 - lng).EntireRow.Insert lng = 0 End If Loop rng.End(xlDown).Offset(1, 0).EntireRow.Delete End Sub -- HTH... Jim Thomlinson "Jim Thomlinson" wrote: This should be close... Sub test() Dim rng As Range Dim lng As Long Set rng = Cells(Rows.Count, "J").End(xlUp) Range(rng, Range("J2")).Sort Key1:=Range("J2"), Order1:=xlAscending, _ Header:=xlNo Set rng = Cells(Rows.Count, "J").End(xlUp) lng = 0 Do While rng.Row 2 Set rng = rng.Offset(-1, 0) If rng.Value < rng.Offset(1, 0).Value Then Do While rng.Value = rng.Offset(-lng) lng = lng + 1 Loop rng.Offset(1, 0).Resize(1000 - lng).EntireRow.Insert lng = 0 End If Loop rng.End(xlDown).Offset(1, 0).EntireRow.Delete End Sub -- HTH... Jim Thomlinson "ReportSmith" wrote: A 2-part question. I have code that will sort a a dataset (with multiple rows and columns) by the data in column "J" (a STATE field). Then, the code will cycle through the sorted list and everytime a state changes, new lines will be entered to the next 1,000th (so if 'AK' has 700 rows, 300 blank lines will be entered before the 'AL' rows (which will start on row 1001; if 'AK' has 1100 rows, 900 blank lines willbe entered before the 'AL' rows (which will start on row 2001, etc). The code works, but not as fast as I would like to see. Does anyone have any suggestions for a faster way? Sub Test() Cells.Select Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'go to the State column, row 2 Application.Goto reference:="R2C10" PrevCell = ActiveCell.Value RowNum = 1 Do Until PrevCell = "" 'find the next state Do Until ActiveCell.Value < PrevCell Application.Goto reference:="R" & RowNum + 1 & "C10" RowNum = RowNum + 1 Loop 'find the next 1000th line NewRow = Application.WorksheetFunction.Ceiling(RowNum, 1000) 'do until the next 1000th line Do While RowNum <= NewRow Rows(RowNum).Select 'select the row Selection.Insert Shift:=xlDown 'insert blank line RowNum = RowNum + 1 'go to next row Loop 'move 1 row down and column J Application.Goto reference:="R" & NewRow + 1 & "C10" PrevCell = ActiveCell.Value Loop End Sub Thanks in advance for any/all suggestions. |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quicker Counting
Jim, This happens to all of us often.
I tested your solution and it does the same as mine. I only felt that FIND would be a bit quicker on a large data field "Jim Thomlinson" wrote in message ... This is not directed solely at you but I feel the need to vent a bit. If there are parameters such as you only want minor tweaks to your existing code and are not interested in other solutions then please specify that ahead of time. When you do not even take the time to test my solution, you have completely wasted my time. When you waste the time of people who are providing the solutions it does not bode well for getting help in the future. If someone has taken the considerable time to provide a solution the least you can do is to test it and give them some feedback. -- HTH... Jim Thomlinson "ReportSmith" wrote: Thanks for the suggestions. I will try them out as time allows (as always, time is of the essence). In the meantime, I will go with the code I have. Thanks again. "Jim Thomlinson" wrote: Ooops... I just noticed mine is only sorting column J... Try this... Sub test() Dim rng As Range Dim lng As Long Set rng = Cells(Rows.Count, "J").End(xlUp) Range(rng, Range("J2")).EntireRow.Sort Key1:=Range("J2"), Order1:=xlAscending, _ Header:=xlNo Set rng = Cells(Rows.Count, "J").End(xlUp) lng = 0 Do While rng.Row 2 Set rng = rng.Offset(-1, 0) If rng.Value < rng.Offset(1, 0).Value Then Do While rng.Value = rng.Offset(-lng) lng = lng + 1 Loop rng.Offset(1, 0).Resize(20 - lng).EntireRow.Insert lng = 0 End If Loop rng.End(xlDown).Offset(1, 0).EntireRow.Delete End Sub -- HTH... Jim Thomlinson "Jim Thomlinson" wrote: This should be close... Sub test() Dim rng As Range Dim lng As Long Set rng = Cells(Rows.Count, "J").End(xlUp) Range(rng, Range("J2")).Sort Key1:=Range("J2"), Order1:=xlAscending, _ Header:=xlNo Set rng = Cells(Rows.Count, "J").End(xlUp) lng = 0 Do While rng.Row 2 Set rng = rng.Offset(-1, 0) If rng.Value < rng.Offset(1, 0).Value Then Do While rng.Value = rng.Offset(-lng) lng = lng + 1 Loop rng.Offset(1, 0).Resize(1000 - lng).EntireRow.Insert lng = 0 End If Loop rng.End(xlDown).Offset(1, 0).EntireRow.Delete End Sub -- HTH... Jim Thomlinson "ReportSmith" wrote: A 2-part question. I have code that will sort a a dataset (with multiple rows and columns) by the data in column "J" (a STATE field). Then, the code will cycle through the sorted list and everytime a state changes, new lines will be entered to the next 1,000th (so if 'AK' has 700 rows, 300 blank lines will be entered before the 'AL' rows (which will start on row 1001; if 'AK' has 1100 rows, 900 blank lines willbe entered before the 'AL' rows (which will start on row 2001, etc). The code works, but not as fast as I would like to see. Does anyone have any suggestions for a faster way? Sub Test() Cells.Select Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'go to the State column, row 2 Application.Goto reference:="R2C10" PrevCell = ActiveCell.Value RowNum = 1 Do Until PrevCell = "" 'find the next state Do Until ActiveCell.Value < PrevCell Application.Goto reference:="R" & RowNum + 1 & "C10" RowNum = RowNum + 1 Loop 'find the next 1000th line NewRow = Application.WorksheetFunction.Ceiling(RowNum, 1000) 'do until the next 1000th line Do While RowNum <= NewRow Rows(RowNum).Select 'select the row Selection.Insert Shift:=xlDown 'insert blank line RowNum = RowNum + 1 'go to next row Loop 'move 1 row down and column J Application.Goto reference:="R" & NewRow + 1 & "C10" PrevCell = ActiveCell.Value Loop End Sub Thanks in advance for any/all suggestions. |
|
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quicker Counting
Using FIND should be quicker that each row. Adapt to suit
Sub PlaceBlankRowsBetweenValues() 'Columns(1).SpecialCells(xlCellTypeBlanks).Delete lr = Cells(Rows.count, "a").End(xlUp).Row With Range("A1:A" & lr) ..AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=.Range("C1"), Unique:=True End With 'pick an UNused column lrc = Cells(Rows.count, "c").End(xlUp).Row mylist = Application.Transpose(Range("C2:C" & lrc)) Columns("c").ClearContents On Error GoTo nomo For i = 1 To lr p1 = Cells.Find(mylist(i), After:=Range("a1"), LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row MsgBox p1 p2 = Cells.Find(mylist(i + 1), After:=Cells(p1, 1), LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row 'MsgBox p2 dif = Application.CountIf(Columns(1), mylist(i)) 'MsgBox dif If dif < 10 Then Cells(p2, 1).Resize(10 - dif).EntireRow.Insert 'Select Next i nomo: End Sub "ReportSmith" wrote in message ... A 2-part question. I have code that will sort a a dataset (with multiple rows and columns) by the data in column "J" (a STATE field). Then, the code will cycle through the sorted list and everytime a state changes, new lines will be entered to the next 1,000th (so if 'AK' has 700 rows, 300 blank lines will be entered before the 'AL' rows (which will start on row 1001; if 'AK' has 1100 rows, 900 blank lines willbe entered before the 'AL' rows (which will start on row 2001, etc). The code works, but not as fast as I would like to see. Does anyone have any suggestions for a faster way? Sub Test() Cells.Select Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'go to the State column, row 2 Application.Goto reference:="R2C10" PrevCell = ActiveCell.Value RowNum = 1 Do Until PrevCell = "" 'find the next state Do Until ActiveCell.Value < PrevCell Application.Goto reference:="R" & RowNum + 1 & "C10" RowNum = RowNum + 1 Loop 'find the next 1000th line NewRow = Application.WorksheetFunction.Ceiling(RowNum, 1000) 'do until the next 1000th line Do While RowNum <= NewRow Rows(RowNum).Select 'select the row Selection.Insert Shift:=xlDown 'insert blank line RowNum = RowNum + 1 'go to next row Loop 'move 1 row down and column J Application.Goto reference:="R" & NewRow + 1 & "C10" PrevCell = ActiveCell.Value Loop End Sub Thanks in advance for any/all suggestions. |
|
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quicker Counting
Thanks Don. I tried it out, but got stuck with the following line when
compiling: ...AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("C1"), Unique:=True Not quite sure what the "..AdvancedFilter" means. "Don Guillett" wrote: Using FIND should be quicker that each row. Adapt to suit Sub PlaceBlankRowsBetweenValues() 'Columns(1).SpecialCells(xlCellTypeBlanks).Delete lr = Cells(Rows.count, "a").End(xlUp).Row With Range("A1:A" & lr) ..AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=.Range("C1"), Unique:=True End With 'pick an UNused column lrc = Cells(Rows.count, "c").End(xlUp).Row mylist = Application.Transpose(Range("C2:C" & lrc)) Columns("c").ClearContents On Error GoTo nomo For i = 1 To lr p1 = Cells.Find(mylist(i), After:=Range("a1"), LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row MsgBox p1 p2 = Cells.Find(mylist(i + 1), After:=Cells(p1, 1), LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row 'MsgBox p2 dif = Application.CountIf(Columns(1), mylist(i)) 'MsgBox dif If dif < 10 Then Cells(p2, 1).Resize(10 - dif).EntireRow.Insert 'Select Next i nomo: End Sub "ReportSmith" wrote in message ... A 2-part question. I have code that will sort a a dataset (with multiple rows and columns) by the data in column "J" (a STATE field). Then, the code will cycle through the sorted list and everytime a state changes, new lines will be entered to the next 1,000th (so if 'AK' has 700 rows, 300 blank lines will be entered before the 'AL' rows (which will start on row 1001; if 'AK' has 1100 rows, 900 blank lines willbe entered before the 'AL' rows (which will start on row 2001, etc). The code works, but not as fast as I would like to see. Does anyone have any suggestions for a faster way? Sub Test() Cells.Select Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'go to the State column, row 2 Application.Goto reference:="R2C10" PrevCell = ActiveCell.Value RowNum = 1 Do Until PrevCell = "" 'find the next state Do Until ActiveCell.Value < PrevCell Application.Goto reference:="R" & RowNum + 1 & "C10" RowNum = RowNum + 1 Loop 'find the next 1000th line NewRow = Application.WorksheetFunction.Ceiling(RowNum, 1000) 'do until the next 1000th line Do While RowNum <= NewRow Rows(RowNum).Select 'select the row Selection.Insert Shift:=xlDown 'insert blank line RowNum = RowNum + 1 'go to next row Loop 'move 1 row down and column J Application.Goto reference:="R" & NewRow + 1 & "C10" PrevCell = ActiveCell.Value Loop End Sub Thanks in advance for any/all suggestions. |
|
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quicker Counting
Disregard the first response. I got it. the "..AdvancedFind" should be
".AdvancedFind" "Don Guillett" wrote: Using FIND should be quicker that each row. Adapt to suit Sub PlaceBlankRowsBetweenValues() 'Columns(1).SpecialCells(xlCellTypeBlanks).Delete lr = Cells(Rows.count, "a").End(xlUp).Row With Range("A1:A" & lr) ..AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=.Range("C1"), Unique:=True End With 'pick an UNused column lrc = Cells(Rows.count, "c").End(xlUp).Row mylist = Application.Transpose(Range("C2:C" & lrc)) Columns("c").ClearContents On Error GoTo nomo For i = 1 To lr p1 = Cells.Find(mylist(i), After:=Range("a1"), LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row MsgBox p1 p2 = Cells.Find(mylist(i + 1), After:=Cells(p1, 1), LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row 'MsgBox p2 dif = Application.CountIf(Columns(1), mylist(i)) 'MsgBox dif If dif < 10 Then Cells(p2, 1).Resize(10 - dif).EntireRow.Insert 'Select Next i nomo: End Sub "ReportSmith" wrote in message ... A 2-part question. I have code that will sort a a dataset (with multiple rows and columns) by the data in column "J" (a STATE field). Then, the code will cycle through the sorted list and everytime a state changes, new lines will be entered to the next 1,000th (so if 'AK' has 700 rows, 300 blank lines will be entered before the 'AL' rows (which will start on row 1001; if 'AK' has 1100 rows, 900 blank lines willbe entered before the 'AL' rows (which will start on row 2001, etc). The code works, but not as fast as I would like to see. Does anyone have any suggestions for a faster way? Sub Test() Cells.Select Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'go to the State column, row 2 Application.Goto reference:="R2C10" PrevCell = ActiveCell.Value RowNum = 1 Do Until PrevCell = "" 'find the next state Do Until ActiveCell.Value < PrevCell Application.Goto reference:="R" & RowNum + 1 & "C10" RowNum = RowNum + 1 Loop 'find the next 1000th line NewRow = Application.WorksheetFunction.Ceiling(RowNum, 1000) 'do until the next 1000th line Do While RowNum <= NewRow Rows(RowNum).Select 'select the row Selection.Insert Shift:=xlDown 'insert blank line RowNum = RowNum + 1 'go to next row Loop 'move 1 row down and column J Application.Goto reference:="R" & NewRow + 1 & "C10" PrevCell = ActiveCell.Value Loop End Sub Thanks in advance for any/all suggestions. |
|
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quicker Counting
A little cleanup and adapting for you
Sub PlaceBlankRowsBetweenValues() 'Columns("J").SpecialCells(xlCellTypeBlanks).Delet e lr = Cells(Rows.count, "j").End(xlUp).Row With Range("j1:j" & lr) ..AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=.Range("k1"), Unique:=True End With 'pick an UNused column instead of K lrk = Cells(Rows.count, "k").End(xlUp).Row mylist = Application.Transpose(Range("k2:k" & lrc)) Columns("k").ClearContents On Error GoTo nomo For i = 1 To lrk p1 = Cells.Find(mylist(i), After:=Range("j1"), LookIn:=xlValues, LookAt:= _ xlwhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row 'MsgBox p1 p2 = Cells.Find(mylist(i + 1), After:=Cells(p1, 1), LookIn:=xlValues, LookAt:= _ xlwhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row 'MsgBox p2 dif = Application.CountIf(Columns("J"), mylist(i)) 'MsgBox dif If dif < 10 Then Cells(p2, "J").Resize(10 - dif).EntireRow.Insert 'Select Next i nomo: End Sub "Don Guillett" wrote in message ... Using FIND should be quicker that each row. Adapt to suit Sub PlaceBlankRowsBetweenValues() 'Columns(1).SpecialCells(xlCellTypeBlanks).Delete lr = Cells(Rows.count, "a").End(xlUp).Row With Range("A1:A" & lr) .AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=.Range("C1"), Unique:=True End With 'pick an UNused column lrc = Cells(Rows.count, "c").End(xlUp).Row mylist = Application.Transpose(Range("C2:C" & lrc)) Columns("c").ClearContents On Error GoTo nomo For i = 1 To lr p1 = Cells.Find(mylist(i), After:=Range("a1"), LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row MsgBox p1 p2 = Cells.Find(mylist(i + 1), After:=Cells(p1, 1), LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row 'MsgBox p2 dif = Application.CountIf(Columns(1), mylist(i)) 'MsgBox dif If dif < 10 Then Cells(p2, 1).Resize(10 - dif).EntireRow.Insert 'Select Next i nomo: End Sub "ReportSmith" wrote in message ... A 2-part question. I have code that will sort a a dataset (with multiple rows and columns) by the data in column "J" (a STATE field). Then, the code will cycle through the sorted list and everytime a state changes, new lines will be entered to the next 1,000th (so if 'AK' has 700 rows, 300 blank lines will be entered before the 'AL' rows (which will start on row 1001; if 'AK' has 1100 rows, 900 blank lines willbe entered before the 'AL' rows (which will start on row 2001, etc). The code works, but not as fast as I would like to see. Does anyone have any suggestions for a faster way? Sub Test() Cells.Select Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'go to the State column, row 2 Application.Goto reference:="R2C10" PrevCell = ActiveCell.Value RowNum = 1 Do Until PrevCell = "" 'find the next state Do Until ActiveCell.Value < PrevCell Application.Goto reference:="R" & RowNum + 1 & "C10" RowNum = RowNum + 1 Loop 'find the next 1000th line NewRow = Application.WorksheetFunction.Ceiling(RowNum, 1000) 'do until the next 1000th line Do While RowNum <= NewRow Rows(RowNum).Select 'select the row Selection.Insert Shift:=xlDown 'insert blank line RowNum = RowNum + 1 'go to next row Loop 'move 1 row down and column J Application.Goto reference:="R" & NewRow + 1 & "C10" PrevCell = ActiveCell.Value Loop End Sub Thanks in advance for any/all suggestions. |
|
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quicker Counting
Don,
It's 6pm here and I finally got a chance to test your code. It is pretty quick, but it does not take into account a few things, although I did see how to get a count of records in the dataset (I can definitely use that). The code enters lines from row 1 and with each iteration of the For..Next loop, more lines are added from the top. It does not find the next state and do the next 1000th 'ceiling'. Maybe I modified the code wrong. Also, I found a variable <lrc that wasn't initialized, but used in the following line(s): ...... lr = Cells(Rows.Count, "j").End(xlUp).Row With Range("j1:j" & lr) .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("aj1"), Unique:=True End With 'pick an UNused column instead of K lrk = Cells(Rows.Count, "aj").End(xlUp).Row mylist = Application.Transpose(Range("aj2:aj" & lrk)) '<-----was <lrc - mistake? ...... I used column "AJ" instead of "K" (I have data from col "A" to col "AA") Like I said, maybe I modified the code incorrectly. Any suggestions? Thanks again. "Don Guillett" wrote: A little cleanup and adapting for you Sub PlaceBlankRowsBetweenValues() 'Columns("J").SpecialCells(xlCellTypeBlanks).Delet e lr = Cells(Rows.count, "j").End(xlUp).Row With Range("j1:j" & lr) ..AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=.Range("k1"), Unique:=True End With 'pick an UNused column instead of K lrk = Cells(Rows.count, "k").End(xlUp).Row mylist = Application.Transpose(Range("k2:k" & lrc)) Columns("k").ClearContents On Error GoTo nomo For i = 1 To lrk p1 = Cells.Find(mylist(i), After:=Range("j1"), LookIn:=xlValues, LookAt:= _ xlwhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row 'MsgBox p1 p2 = Cells.Find(mylist(i + 1), After:=Cells(p1, 1), LookIn:=xlValues, LookAt:= _ xlwhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row 'MsgBox p2 dif = Application.CountIf(Columns("J"), mylist(i)) 'MsgBox dif If dif < 10 Then Cells(p2, "J").Resize(10 - dif).EntireRow.Insert 'Select Next i nomo: End Sub "Don Guillett" wrote in message ... Using FIND should be quicker that each row. Adapt to suit Sub PlaceBlankRowsBetweenValues() 'Columns(1).SpecialCells(xlCellTypeBlanks).Delete lr = Cells(Rows.count, "a").End(xlUp).Row With Range("A1:A" & lr) .AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=.Range("C1"), Unique:=True End With 'pick an UNused column lrc = Cells(Rows.count, "c").End(xlUp).Row mylist = Application.Transpose(Range("C2:C" & lrc)) Columns("c").ClearContents On Error GoTo nomo For i = 1 To lr p1 = Cells.Find(mylist(i), After:=Range("a1"), LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row MsgBox p1 p2 = Cells.Find(mylist(i + 1), After:=Cells(p1, 1), LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row 'MsgBox p2 dif = Application.CountIf(Columns(1), mylist(i)) 'MsgBox dif If dif < 10 Then Cells(p2, 1).Resize(10 - dif).EntireRow.Insert 'Select Next i nomo: End Sub "ReportSmith" wrote in message ... A 2-part question. I have code that will sort a a dataset (with multiple rows and columns) by the data in column "J" (a STATE field). Then, the code will cycle through the sorted list and everytime a state changes, new lines will be entered to the next 1,000th (so if 'AK' has 700 rows, 300 blank lines will be entered before the 'AL' rows (which will start on row 1001; if 'AK' has 1100 rows, 900 blank lines willbe entered before the 'AL' rows (which will start on row 2001, etc). The code works, but not as fast as I would like to see. Does anyone have any suggestions for a faster way? Sub Test() Cells.Select Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'go to the State column, row 2 Application.Goto reference:="R2C10" PrevCell = ActiveCell.Value RowNum = 1 Do Until PrevCell = "" 'find the next state Do Until ActiveCell.Value < PrevCell Application.Goto reference:="R" & RowNum + 1 & "C10" RowNum = RowNum + 1 Loop 'find the next 1000th line NewRow = Application.WorksheetFunction.Ceiling(RowNum, 1000) 'do until the next 1000th line Do While RowNum <= NewRow Rows(RowNum).Select 'select the row Selection.Insert Shift:=xlDown 'insert blank line RowNum = RowNum + 1 'go to next row Loop 'move 1 row down and column J Application.Goto reference:="R" & NewRow + 1 & "C10" PrevCell = ActiveCell.Value Loop End Sub Thanks in advance for any/all suggestions. |
|
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Quicker Counting
|
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| looking for a function to make it more quicker | Excel Worksheet Functions | |||
| quicker copydown | Excel Programming | |||
| How do I get files to open quicker | Excel Discussion (Misc queries) | |||
| Is there a shorter/quicker way to do this? | Excel Worksheet Functions | |||
| Any quicker ideas? | Excel Programming | |||
Hybrid Mode
