Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop too slow deleteing xltoleft
Good afternoon,
I am re-creating a SAP profit centre hierarchy in excel. Previous macros that i use will put data in columns A to column G. This will give me a spreadsheet that looks like this: Assume y's and x's are 10 digit number/letters A B C D E F G yyyyy xxxxx xxxxx xxxxx xxxxx xxxxx yyyyy xxxxx xxxxx xxxxx xxxxx yyyyy xxxxx yyyyy xxxxx xxxxx yyyyy xxxxx xxxxx xxxxx xxxxx xxxxx xxxxx yyyyy xxxxx xxxxx xxxxx xxxxx xxxxx xxxxx yyyyy xxxxx xxxxx xxxxx The macro, attached below, I have written checks to see if there is anything in column A and if nothing in col B then delete left till column B has a value. Then move onto the next row. The problem is that it is too slow, over 9 mins, for it too process anything between 4000 and 25000 rows. Can you please help and include comments so that I can learn. Ta, Marc Sub parent_alignment() Application.StatusBar = "SAP hierarchy alignment" Application.ScreenUpdating = False On Error Resume Next Dim rngcell As Range Sheets("SAP").Activate Range("A2:A25000").Activate For Each rngcell In Selection If rngcell < blank And rngcell.Offset(0, 1) = blank Then Do Until rngcell.Offset(0, 1) < blank rngcell.Offset(0, 1).Delete Shift:=xlToLeft Loop End If Next rngcell Application.StatusBar = "All done" Application.ScreenUpdating = True End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop too slow deleteing xltoleft
The following below will only select the rows that actually have data in
them. This means you won't have to check if there is data in other cells that you have in your range. Its probably not a hell of a lot of use in speeding up the large files though. With Worksheets(("SAP"). 'The range is row 5, column 1 , ("a2")then find end of column by codes Set rngcell = Range(.Cells(5, 1), .Cells(Rows.Count, 1).End(xlUp)) End with |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop too slow deleteing xltoleft
Try this macro on a copy of your worksheet:
Sub test() Dim lastRow As Long Dim myRange Dim i As Long, j As Integer, k As Integer Dim test As Boolean Application.ScreenUpdating = False Sheets("SAP").Activate lastRow = Cells(Rows.Count, "A").End(xlUp).Row - 1 'Find last row ReDim myRange(2 To lastRow, 1 To 7) 'size array For i = 2 To lastRow 'fill array myRange by row For j = 1 To 7 'fill array by column myRange(i, j) = Cells(i, j).Value 'actual fill Next j Next i For i = 2 To lastRow 'cycle through each row If myRange(i, 1) < "" Then 'check if column a is filled For j = 2 To 7 'cycle through columns If myRange(i, 2) = "" Then test = True 'is "B" empty? Do While test = True 'do while "B" is empty For k = 2 To 6 'then shift cells from right myRange(i, k) = myRange(i, k + 1) If myRange(i, 7) = "" Then test = False 'Prevents endless loop in empty line Next k myRange(i, 7) = "" 'empty cell "G" If myRange(i, 2) < "" Then test = False ' "B" is now filled Loop Next j End If Next i Range(Cells(2, 1), Cells(lastRow, 7)).ClearContents 'Clear original range Range(Cells(2, 1), Cells(lastRow, 7)) = myRange 'Fill original range with new values Application.ScreenUpdating = True End Sub MarcB wrote: Good afternoon, I am re-creating a SAP profit centre hierarchy in excel. Previous macros that i use will put data in columns A to column G. This will give me a spreadsheet that looks like this: Assume y's and x's are 10 digit number/letters A B C D E F G yyyyy xxxxx xxxxx xxxxx xxxxx xxxxx yyyyy xxxxx xxxxx xxxxx xxxxx yyyyy xxxxx yyyyy xxxxx xxxxx yyyyy xxxxx xxxxx xxxxx xxxxx xxxxx xxxxx yyyyy xxxxx xxxxx xxxxx xxxxx xxxxx xxxxx yyyyy xxxxx xxxxx xxxxx The macro, attached below, I have written checks to see if there is anything in column A and if nothing in col B then delete left till column B has a value. Then move onto the next row. The problem is that it is too slow, over 9 mins, for it too process anything between 4000 and 25000 rows. Can you please help and include comments so that I can learn. Ta, Marc Sub parent_alignment() Application.StatusBar = "SAP hierarchy alignment" Application.ScreenUpdating = False On Error Resume Next Dim rngcell As Range Sheets("SAP").Activate Range("A2:A25000").Activate For Each rngcell In Selection If rngcell < blank And rngcell.Offset(0, 1) = blank Then Do Until rngcell.Offset(0, 1) < blank rngcell.Offset(0, 1).Delete Shift:=xlToLeft Loop End If Next rngcell Application.StatusBar = "All done" Application.ScreenUpdating = True End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop too slow deleteing xltoleft
Change line:
lastRow = Cells(Rows.Count, "A").End(xlUp).Row - 1 'Find last row to: lastRow = Cells(65536, 1).End(xlUp).Row 'Find last row missed last line otherwise. JWolf wrote: Try this macro on a copy of your worksheet: Sub test() Dim lastRow As Long Dim myRange Dim i As Long, j As Integer, k As Integer Dim test As Boolean Application.ScreenUpdating = False Sheets("SAP").Activate lastRow = Cells(Rows.Count, "A").End(xlUp).Row - 1 'Find last row ReDim myRange(2 To lastRow, 1 To 7) 'size array For i = 2 To lastRow 'fill array myRange by row For j = 1 To 7 'fill array by column myRange(i, j) = Cells(i, j).Value 'actual fill Next j Next i For i = 2 To lastRow 'cycle through each row If myRange(i, 1) < "" Then 'check if column a is filled For j = 2 To 7 'cycle through columns If myRange(i, 2) = "" Then test = True 'is "B" empty? Do While test = True 'do while "B" is empty For k = 2 To 6 'then shift cells from right myRange(i, k) = myRange(i, k + 1) If myRange(i, 7) = "" Then test = False 'Prevents endless loop in empty line Next k myRange(i, 7) = "" 'empty cell "G" If myRange(i, 2) < "" Then test = False ' "B" is now filled Loop Next j End If Next i Range(Cells(2, 1), Cells(lastRow, 7)).ClearContents 'Clear original range Range(Cells(2, 1), Cells(lastRow, 7)) = myRange 'Fill original range with new values Application.ScreenUpdating = True End Sub MarcB wrote: Good afternoon, I am re-creating a SAP profit centre hierarchy in excel. Previous macros that i use will put data in columns A to column G. This will give me a spreadsheet that looks like this: Assume y's and x's are 10 digit number/letters A B C D E F G yyyyy xxxxx xxxxx xxxxx xxxxx xxxxx yyyyy xxxxx xxxxx xxxxx xxxxx yyyyy xxxxx yyyyy xxxxx xxxxx yyyyy xxxxx xxxxx xxxxx xxxxx xxxxx xxxxx yyyyy xxxxx xxxxx xxxxx xxxxx xxxxx xxxxx yyyyy xxxxx xxxxx xxxxx The macro, attached below, I have written checks to see if there is anything in column A and if nothing in col B then delete left till column B has a value. Then move onto the next row. The problem is that it is too slow, over 9 mins, for it too process anything between 4000 and 25000 rows. Can you please help and include comments so that I can learn. Ta, Marc Sub parent_alignment() Application.StatusBar = "SAP hierarchy alignment" Application.ScreenUpdating = False On Error Resume Next Dim rngcell As Range Sheets("SAP").Activate Range("A2:A25000").Activate For Each rngcell In Selection If rngcell < blank And rngcell.Offset(0, 1) = blank Then Do Until rngcell.Offset(0, 1) < blank rngcell.Offset(0, 1).Delete Shift:=xlToLeft Loop End If Next rngcell Application.StatusBar = "All done" Application.ScreenUpdating = True End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop too slow deleteing xltoleft
Superb.
Many thanks to you both. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop too slow deleteing xltoleft
Thanks for that. I worked that out after 5 go's of going what is wrong
with the last row?? Using the code which you supplied has given me an idea for the stage before I get to remove the empty cells. Would you mind if I picked your brain??? I think it could hopefuly be changing a few lines of your code which you supplied. My data in orginal format looks like this: A B-j(all blank) K L yyyy xxxx xxxx yyyy xxxx xxxx yyyy xxxx xxxx yyyy xxxx xxxx yyyy xxxx xxxx yyyy xxxx xxxx yyyy xxxx xxxx I then run a macro which is slow (i thinking large calculation doesn't help) which finds if there is a value in K, put in the formula "=VLOOKUP(RC[1],setnode!C4:C5,2,FALSE)" in cells B-J. I then value it and change the #n/a's to blank. Can you help? Sorry to be a pain :-) I like the lastrow you use instead of determining a setting a range as i do. Thanks again, Marc Sub SAP_hier1() Application.ScreenUpdating = False On Error Resume Next Dim rngcell As Range Sheets("SAP").Activate Range("K2:K25000").Activate For Each rngcell In Selection If rngcell < blank Then rngcell.Offset(0, -1).FormulaR1C1 = "=VLOOKUP(RC[1],setnode!C4:C5,2,FALSE)" rngcell.Offset(0, -1).AutoFill Destination:=Range(rngcell.Offset(0, -9), rngcell.Offset(0, -1)), Type:=xlFillDefault Range(rngcell.Offset(0, -9), rngcell.Offset(0, -1)).Copy Range(rngcell.Offset(0, -9), rngcell.Offset(0, -1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range(rngcell.Offset(0, -9), rngcell.Offset(0, -1)).Replace "#N/A", Null Else End If Next rngcell Application.ScreenUpdating = True End Sub JWolf wrote in message ... Change line: lastRow = Cells(Rows.Count, "A").End(xlUp).Row - 1 'Find last row to: lastRow = Cells(65536, 1).End(xlUp).Row 'Find last row missed last line otherwise. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Slow VBA code....Hide/Unhide Loop | Excel Worksheet Functions | |||
VBA loop slow if another workbook open | Excel Discussion (Misc queries) | |||
deleteing objects | Excel Discussion (Misc queries) | |||
Deleteing | Excel Discussion (Misc queries) | |||
slow program in a loop | Excel Programming |