| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
slow code with many loopings
Dear experts,
I have a long code (below) with many loopings to match cell values and long data lists, which is causing my code to be extremely slow (1 h) I am sure there is a better and faster way to do this... itwould be great if you could help me! Many thanks in advance. Best regards -- Valeria Sub RawMatConsumption() Dim FillIn As Integer, Length As Integer, LastRowSales As Integer, LastRowBOMS As Integer, i As Integer, k As Integer, g As Integer, h As Integer, FinishedGMID As Integer, Row1 As Integer, FirstGMIDRow As Integer, LastGMIDRow As Integer, LastRowRWM As Integer Dim mc As Range Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False 'for some reason the xllastcell does not work correctly here so I am looping to find the last cell i = 1 Do i = i + 1 Loop Until Worksheets("Sales Forecast").Cells(i, 1) = "Account Manager" Row1 = i + 1 i = Row1 Do i = i + 1 Loop Until Worksheets("Sales Forecast").Cells(i, 2) = "" LastRowSales = i i = 1 Do i = i + 1 Loop Until Worksheets("Raw Materials Forecast").Cells(i, 3) = "" LastRowRWM = i 'Last Row on BOMS Set mc = Worksheets("BOMS").Cells.SpecialCells(xlCellTypeLa stCell) LastRowBOMS = mc.Row 'to obtain a 8 digit text to be able to compare with the other data For i = 1 To LastRowBOMS If IsNumeric(Worksheets("BOMS").Cells(i, 1)) = True Then Worksheets("BOMS").Cells(i, 1).NumberFormat = "@" If Len(Worksheets("BOMS").Cells(i, 1)) < 8 Then If Len(Worksheets("BOMS").Cells(i, 1)) = 7 Then Worksheets("BOMS").Cells(i, 1) = "0" & Worksheets("BOMS").Cells(i, 1) ElseIf Len(Worksheets("BOMS").Cells(i, 1)) = 6 Then Worksheets("BOMS").Cells(i, 1) = "00" & Worksheets("BOMS").Cells(i, 1) ElseIf Len(Worksheets("BOMS").Cells(i, 1)) = 5 Then Worksheets("BOMS").Cells(i, 1) = "000" & Worksheets("BOMS").Cells(i, 1) End If End If End If Next i For i = 1 To LastRowRWM If IsNumeric(Worksheets("Raw Materials Forecast").Cells(i, 4)) = True Then Worksheets("Raw Materials Forecast").Cells(i, 4).NumberFormat = "@" If Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) < 8 Then If Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) = 7 Then Worksheets("Raw Materials Forecast").Cells(i, 4) = "0" & Worksheets("Raw Materials Forecast").Cells(i, 4) ElseIf Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) = 6 Then Worksheets("Raw Materials Forecast").Cells(i, 4) = "00" & Worksheets("Raw Materials Forecast").Cells(i, 4) ElseIf Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) = 5 Then Worksheets("Raw Materials Forecast").Cells(i, 4) = "000" & Worksheets("Raw Materials Forecast").Cells(i, 4) End If End If End If Next i 'Put on the left the finished product GMID (=blue) Worksheets("BOMS").Columns(1).Insert Shift:=xlToRight For i = 1 To LastRowBOMS If Worksheets("BOMS").Cells(i, 2).Font.ColorIndex = 5 Then Worksheets("BOMS").Cells(i, 1) = Worksheets("BOMS").Cells(i, 2) Worksheets("BOMS").Cells(i, 2).ClearContents End If Next i 'Look for the BOM of the GMIDs Worksheets("Sales Forecast").AutoFilterMode = False 'this is where it starts to be extremely slow.... For k = Row1 To LastRowSales i = 1 Do i = i + 1 Loop Until Worksheets("Sales Forecast").Cells(k, 7) = Worksheets("BOMS").Cells(i, 1) Or i LastRowBOMS If i < LastRowBOMS Then FinishedGMID = i FirstGMIDRow = i + 4 Do i = i + 1 Loop Until IsEmpty(Worksheets("BOMS").Cells(i, 1)) = False Or i LastRowBOMS If i < LastRowBOMS Then LastGMIDRow = i - 4 Else LastGMIDRow = i End If For h = FirstGMIDRow To LastGMIDRow i = 1 Do i = i + 1 Loop Until Worksheets("BOMS").Cells(i, 1) = Worksheets("BOMS").Cells(h, 2) Or i LastRowBOMS If i < LastRowBOMS Then 'what to do when the rwm is not the real raw mat? Still in progress Else g = 1 Do g = g + 1 Loop Until Worksheets("Raw Materials Forecast").Cells(g, 4) = Worksheets("BOMS").Cells(h, 2) Or g LastRowRWM If g < LastRowRWM Then Worksheets("Raw Materials Forecast").Cells(g, 7) = Worksheets("Raw Materials Forecast").Cells(g, 7) + Worksheets("Sales Forecast").Cells(k, 17) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(g, 8) = Worksheets("Raw Materials Forecast").Cells(g, 8) + Worksheets("Sales Forecast").Cells(k, 19) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(g, 9) = Worksheets("Raw Materials Forecast").Cells(g, 9) + Worksheets("Sales Forecast").Cells(k, 21) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Else Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 4) = Worksheets("BOMS").Cells(h, 2) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 5) = Worksheets("BOMS").Cells(h, 3) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 6) = Worksheets("BOMS").Cells(FirstGMIDRow - 2, 4) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 7) = Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 7) + Worksheets("Sales Forecast").Cells(k, 17) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 8) = Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 8) + Worksheets("Sales Forecast").Cells(k, 19) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 9) = Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 9) + Worksheets("Sales Forecast").Cells(k, 21) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Range(Cells(LastRowRWM - 1, 1), Cells(LastRowRWM - 1, 9)).Copy Worksheets("Raw Materials Forecast").Range(Cells(LastRowRWM, 1), Cells(LastRowRWM, 9)).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False LastRowRWM = LastRowRWM + 1 End If End If Next h End If Next k Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic End Sub |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
slow code with many loopings
To find the last used cell in any column try a formula such as this:
on the current active sheet: columnLastRow = Range("A" & Rows.Count).End(xlUp).Row for a specific sheet in ThisWorkbook lastRow = ThisWorkbook.Worksheets("SheetName") _ .Range("Z" & Rows.Count).End(xlUp).Row If you prefer to use the .Cells instead of .Range you can, just use Rows.Count for the row number, as: .Cells(Rows.Count, Col#).End(xlUp).Row "Valeria" wrote: Dear experts, I have a long code (below) with many loopings to match cell values and long data lists, which is causing my code to be extremely slow (1 h) I am sure there is a better and faster way to do this... itwould be great if you could help me! Many thanks in advance. Best regards -- Valeria Sub RawMatConsumption() Dim FillIn As Integer, Length As Integer, LastRowSales As Integer, LastRowBOMS As Integer, i As Integer, k As Integer, g As Integer, h As Integer, FinishedGMID As Integer, Row1 As Integer, FirstGMIDRow As Integer, LastGMIDRow As Integer, LastRowRWM As Integer Dim mc As Range Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False 'for some reason the xllastcell does not work correctly here so I am looping to find the last cell i = 1 Do i = i + 1 Loop Until Worksheets("Sales Forecast").Cells(i, 1) = "Account Manager" Row1 = i + 1 i = Row1 Do i = i + 1 Loop Until Worksheets("Sales Forecast").Cells(i, 2) = "" LastRowSales = i i = 1 Do i = i + 1 Loop Until Worksheets("Raw Materials Forecast").Cells(i, 3) = "" LastRowRWM = i 'Last Row on BOMS Set mc = Worksheets("BOMS").Cells.SpecialCells(xlCellTypeLa stCell) LastRowBOMS = mc.Row 'to obtain a 8 digit text to be able to compare with the other data For i = 1 To LastRowBOMS If IsNumeric(Worksheets("BOMS").Cells(i, 1)) = True Then Worksheets("BOMS").Cells(i, 1).NumberFormat = "@" If Len(Worksheets("BOMS").Cells(i, 1)) < 8 Then If Len(Worksheets("BOMS").Cells(i, 1)) = 7 Then Worksheets("BOMS").Cells(i, 1) = "0" & Worksheets("BOMS").Cells(i, 1) ElseIf Len(Worksheets("BOMS").Cells(i, 1)) = 6 Then Worksheets("BOMS").Cells(i, 1) = "00" & Worksheets("BOMS").Cells(i, 1) ElseIf Len(Worksheets("BOMS").Cells(i, 1)) = 5 Then Worksheets("BOMS").Cells(i, 1) = "000" & Worksheets("BOMS").Cells(i, 1) End If End If End If Next i For i = 1 To LastRowRWM If IsNumeric(Worksheets("Raw Materials Forecast").Cells(i, 4)) = True Then Worksheets("Raw Materials Forecast").Cells(i, 4).NumberFormat = "@" If Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) < 8 Then If Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) = 7 Then Worksheets("Raw Materials Forecast").Cells(i, 4) = "0" & Worksheets("Raw Materials Forecast").Cells(i, 4) ElseIf Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) = 6 Then Worksheets("Raw Materials Forecast").Cells(i, 4) = "00" & Worksheets("Raw Materials Forecast").Cells(i, 4) ElseIf Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) = 5 Then Worksheets("Raw Materials Forecast").Cells(i, 4) = "000" & Worksheets("Raw Materials Forecast").Cells(i, 4) End If End If End If Next i 'Put on the left the finished product GMID (=blue) Worksheets("BOMS").Columns(1).Insert Shift:=xlToRight For i = 1 To LastRowBOMS If Worksheets("BOMS").Cells(i, 2).Font.ColorIndex = 5 Then Worksheets("BOMS").Cells(i, 1) = Worksheets("BOMS").Cells(i, 2) Worksheets("BOMS").Cells(i, 2).ClearContents End If Next i 'Look for the BOM of the GMIDs Worksheets("Sales Forecast").AutoFilterMode = False 'this is where it starts to be extremely slow.... For k = Row1 To LastRowSales i = 1 Do i = i + 1 Loop Until Worksheets("Sales Forecast").Cells(k, 7) = Worksheets("BOMS").Cells(i, 1) Or i LastRowBOMS If i < LastRowBOMS Then FinishedGMID = i FirstGMIDRow = i + 4 Do i = i + 1 Loop Until IsEmpty(Worksheets("BOMS").Cells(i, 1)) = False Or i LastRowBOMS If i < LastRowBOMS Then LastGMIDRow = i - 4 Else LastGMIDRow = i End If For h = FirstGMIDRow To LastGMIDRow i = 1 Do i = i + 1 Loop Until Worksheets("BOMS").Cells(i, 1) = Worksheets("BOMS").Cells(h, 2) Or i LastRowBOMS If i < LastRowBOMS Then 'what to do when the rwm is not the real raw mat? Still in progress Else g = 1 Do g = g + 1 Loop Until Worksheets("Raw Materials Forecast").Cells(g, 4) = Worksheets("BOMS").Cells(h, 2) Or g LastRowRWM If g < LastRowRWM Then Worksheets("Raw Materials Forecast").Cells(g, 7) = Worksheets("Raw Materials Forecast").Cells(g, 7) + Worksheets("Sales Forecast").Cells(k, 17) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(g, 8) = Worksheets("Raw Materials Forecast").Cells(g, 8) + Worksheets("Sales Forecast").Cells(k, 19) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(g, 9) = Worksheets("Raw Materials Forecast").Cells(g, 9) + Worksheets("Sales Forecast").Cells(k, 21) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Else Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 4) = Worksheets("BOMS").Cells(h, 2) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 5) = Worksheets("BOMS").Cells(h, 3) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 6) = Worksheets("BOMS").Cells(FirstGMIDRow - 2, 4) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 7) = Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 7) + Worksheets("Sales Forecast").Cells(k, 17) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 8) = Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 8) + Worksheets("Sales Forecast").Cells(k, 19) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 9) = Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 9) + Worksheets("Sales Forecast").Cells(k, 21) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Range(Cells(LastRowRWM - 1, 1), Cells(LastRowRWM - 1, 9)).Copy Worksheets("Raw Materials Forecast").Range(Cells(LastRowRWM, 1), Cells(LastRowRWM, 9)).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False LastRowRWM = LastRowRWM + 1 End If End If Next h End If Next k Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic End Sub |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
slow code with many loopings
Hi,
thank you very much for the suggestion. Will this also work when I have blank cells in the first rows? However, this does unfortunately not hep with my very slow macro... it is when I start the execution of the For loop that everything becomes very slow. Thanks, Kind regards -- Valeria "JLatham" wrote: To find the last used cell in any column try a formula such as this: on the current active sheet: columnLastRow = Range("A" & Rows.Count).End(xlUp).Row for a specific sheet in ThisWorkbook lastRow = ThisWorkbook.Worksheets("SheetName") _ .Range("Z" & Rows.Count).End(xlUp).Row If you prefer to use the .Cells instead of .Range you can, just use Rows.Count for the row number, as: .Cells(Rows.Count, Col#).End(xlUp).Row "Valeria" wrote: Dear experts, I have a long code (below) with many loopings to match cell values and long data lists, which is causing my code to be extremely slow (1 h) I am sure there is a better and faster way to do this... itwould be great if you could help me! Many thanks in advance. Best regards -- Valeria Sub RawMatConsumption() Dim FillIn As Integer, Length As Integer, LastRowSales As Integer, LastRowBOMS As Integer, i As Integer, k As Integer, g As Integer, h As Integer, FinishedGMID As Integer, Row1 As Integer, FirstGMIDRow As Integer, LastGMIDRow As Integer, LastRowRWM As Integer Dim mc As Range Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False 'for some reason the xllastcell does not work correctly here so I am looping to find the last cell i = 1 Do i = i + 1 Loop Until Worksheets("Sales Forecast").Cells(i, 1) = "Account Manager" Row1 = i + 1 i = Row1 Do i = i + 1 Loop Until Worksheets("Sales Forecast").Cells(i, 2) = "" LastRowSales = i i = 1 Do i = i + 1 Loop Until Worksheets("Raw Materials Forecast").Cells(i, 3) = "" LastRowRWM = i 'Last Row on BOMS Set mc = Worksheets("BOMS").Cells.SpecialCells(xlCellTypeLa stCell) LastRowBOMS = mc.Row 'to obtain a 8 digit text to be able to compare with the other data For i = 1 To LastRowBOMS If IsNumeric(Worksheets("BOMS").Cells(i, 1)) = True Then Worksheets("BOMS").Cells(i, 1).NumberFormat = "@" If Len(Worksheets("BOMS").Cells(i, 1)) < 8 Then If Len(Worksheets("BOMS").Cells(i, 1)) = 7 Then Worksheets("BOMS").Cells(i, 1) = "0" & Worksheets("BOMS").Cells(i, 1) ElseIf Len(Worksheets("BOMS").Cells(i, 1)) = 6 Then Worksheets("BOMS").Cells(i, 1) = "00" & Worksheets("BOMS").Cells(i, 1) ElseIf Len(Worksheets("BOMS").Cells(i, 1)) = 5 Then Worksheets("BOMS").Cells(i, 1) = "000" & Worksheets("BOMS").Cells(i, 1) End If End If End If Next i For i = 1 To LastRowRWM If IsNumeric(Worksheets("Raw Materials Forecast").Cells(i, 4)) = True Then Worksheets("Raw Materials Forecast").Cells(i, 4).NumberFormat = "@" If Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) < 8 Then If Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) = 7 Then Worksheets("Raw Materials Forecast").Cells(i, 4) = "0" & Worksheets("Raw Materials Forecast").Cells(i, 4) ElseIf Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) = 6 Then Worksheets("Raw Materials Forecast").Cells(i, 4) = "00" & Worksheets("Raw Materials Forecast").Cells(i, 4) ElseIf Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) = 5 Then Worksheets("Raw Materials Forecast").Cells(i, 4) = "000" & Worksheets("Raw Materials Forecast").Cells(i, 4) End If End If End If Next i 'Put on the left the finished product GMID (=blue) Worksheets("BOMS").Columns(1).Insert Shift:=xlToRight For i = 1 To LastRowBOMS If Worksheets("BOMS").Cells(i, 2).Font.ColorIndex = 5 Then Worksheets("BOMS").Cells(i, 1) = Worksheets("BOMS").Cells(i, 2) Worksheets("BOMS").Cells(i, 2).ClearContents End If Next i 'Look for the BOM of the GMIDs Worksheets("Sales Forecast").AutoFilterMode = False 'this is where it starts to be extremely slow.... For k = Row1 To LastRowSales i = 1 Do i = i + 1 Loop Until Worksheets("Sales Forecast").Cells(k, 7) = Worksheets("BOMS").Cells(i, 1) Or i LastRowBOMS If i < LastRowBOMS Then FinishedGMID = i FirstGMIDRow = i + 4 Do i = i + 1 Loop Until IsEmpty(Worksheets("BOMS").Cells(i, 1)) = False Or i LastRowBOMS If i < LastRowBOMS Then LastGMIDRow = i - 4 Else LastGMIDRow = i End If For h = FirstGMIDRow To LastGMIDRow i = 1 Do i = i + 1 Loop Until Worksheets("BOMS").Cells(i, 1) = Worksheets("BOMS").Cells(h, 2) Or i LastRowBOMS If i < LastRowBOMS Then 'what to do when the rwm is not the real raw mat? Still in progress Else g = 1 Do g = g + 1 Loop Until Worksheets("Raw Materials Forecast").Cells(g, 4) = Worksheets("BOMS").Cells(h, 2) Or g LastRowRWM If g < LastRowRWM Then Worksheets("Raw Materials Forecast").Cells(g, 7) = Worksheets("Raw Materials Forecast").Cells(g, 7) + Worksheets("Sales Forecast").Cells(k, 17) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(g, 8) = Worksheets("Raw Materials Forecast").Cells(g, 8) + Worksheets("Sales Forecast").Cells(k, 19) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(g, 9) = Worksheets("Raw Materials Forecast").Cells(g, 9) + Worksheets("Sales Forecast").Cells(k, 21) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Else Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 4) = Worksheets("BOMS").Cells(h, 2) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 5) = Worksheets("BOMS").Cells(h, 3) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 6) = Worksheets("BOMS").Cells(FirstGMIDRow - 2, 4) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 7) = Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 7) + Worksheets("Sales Forecast").Cells(k, 17) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 8) = Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 8) + Worksheets("Sales Forecast").Cells(k, 19) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 9) = Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 9) + Worksheets("Sales Forecast").Cells(k, 21) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Range(Cells(LastRowRWM - 1, 1), Cells(LastRowRWM - 1, 9)).Copy Worksheets("Raw Materials Forecast").Range(Cells(LastRowRWM, 1), Cells(LastRowRWM, 9)).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False LastRowRWM = LastRowRWM + 1 End If End If Next h End If Next k Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic End Sub |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
slow code with many loopings
Hi
You can use Find rather than looping through a range to find a certain value if present. Also you can use this : ShA.Range("B" & Rows.Count).End(xlUp).Row to find last row with data. Sub RawMatConsumption() Dim FillIn As Long, Length As Long, LastRowSales As Long, LastRowBOMS As Long, _ i As Long, k As Long, g As Long, h As Long, FinishedGMID As Long, Row1 As Long, _ FirstGMIDRow As Long, LastGMIDRow As Long, LastRowRWM As Long Dim mc As Range Dim ShA As Worksheet ' Sales Forecast Dim shB As Worksheet ' BOMS Dim shC As Worksheet 'Raw Materials Forecast Set ShA = Worksheets("Sales Forecast") Set shB = Worksheets("BOMS") Set shC = Worksheets("Raw Materials Forecast") With Application .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False End With Row1 = ShA.Columns(1).Find(what:="Account Manager", after:=ShA.Range("A1"), lookat:=xlWhole, LookIn:=xlValues).Row + 1 LastRowSales = ShA.Range("B" & Rows.Count).End(xlUp).Row 'Last Row on BOMS Set mc = Worksheets("BOMS").Cells.SpecialCells(xlCellTypeLa stCell) LastRowBOMS = mc.Row 'to obtain a 8 digit text to be able to compare with the other data For i = 1 To LastRowBOMS If IsNumeric(shB.Cells(i, 1)) = True Then shB.Cells(i, 1).NumberFormat = "@" If Len(shB.Cells(i, 1)) < 8 Then If Len(shB.Cells(i, 1)) = 7 Then shB.Cells(i, 1) = "0" & shB.Cells(i, 1) ElseIf Len(shB.Cells(i, 1)) = 6 Then shB.Cells(i, 1) = "00" & shB.Cells(i, 1) ElseIf Len(shB.Cells(i, 1)) = 5 Then shB.Cells(i, 1) = "000" & shB.Cells(i, 1) End If End If End If Next i For i = 1 To LastRowRWM If IsNumeric(shC.Cells(i, 4)) = True Then shC.Cells(i, 4).NumberFormat = "@" If Len(shC.Cells(i, 4)) < 8 Then If Len(shC.Cells(i, 4)) = 7 Then shC.Cells(i, 4) = "0" & shC.Cells(i, 4) ElseIf Len(shC.Cells(i, 4)) = 6 Then shC.Cells(i, 4) = "00" & shC.Cells(i, 4) ElseIf Len(shC.Cells(i, 4)) = 5 Then shC.Cells(i, 4) = "000" & shC.Cells(i, 4) End If End If End If Next i 'Put on the left the finished product GMID (=blue) shB.Columns(1).Insert Shift:=xlToRight For i = 1 To LastRowBOMS If shB.Cells(i, 2).Font.ColorIndex = 5 Then shB.Cells(i, 1) = shB.Cells(i, 2) shB.Cells(i, 2).ClearContents End If Next i 'Look for the BOM of the GMIDs ShA.AutoFilterMode = False 'this is where it starts to be extremely slow.... For k = Row1 To LastRowSales Set f = shB.Range("A1:A" & LastRowBOMS).Find(what:=ShA.Cells(k, 7).Value, after:=shB.Range("A1"), LookIn:=xlValues, lookat:=xlWhole) If Not f Is Nothing Then FinishedGMID = i FirstGMIDRow = i + 4 Do i = i + 1 Loop Until IsEmpty(shB.Cells(i, 1)) = False Or i LastRowBOMS If i < LastRowBOMS Then LastGMIDRow = i - 4 Else LastGMIDRow = i End If For h = FirstGMIDRow To LastGMIDRow i = 1 Do i = i + 1 Loop Until shB.Cells(i, 1) = shB.Cells(h, 2) Or i LastRowBOMS If i < LastRowBOMS Then 'what to do when the rwm is not the real raw mat? Still in progress Else g = 1 Do g = g + 1 Loop Until shC.Cells(g, 4) = shB.Cells(h, 2) Or g LastRowRWM If g < LastRowRWM Then shC.Cells(g, 7) = shC.Cells(g, 7) + ShA.Cells(k, 17) * 1000 * shB.Cells(h, 4) / shB.Cells(FinishedGMID + 2, 3) shC.Cells(g, 8) = shC.Cells(g, 8) + ShA.Cells(k, 19) * 1000 * shB.Cells(h, 4) / shB.Cells(FinishedGMID + 2, 3) shC.Cells(g, 9) = shC.Cells(g, 9) + ShA.Cells(k, 21) * 1000 * shB.Cells(h, 4) / shB.Cells(FinishedGMID + 2, 3) Else shC.Cells(LastRowRWM, 4) = shB.Cells(h, 2) shC.Cells(LastRowRWM, 5) = shB.Cells(h, 3) shC.Cells(LastRowRWM, 6) = shB.Cells(FirstGMIDRow - 2, 4) shC.Cells(LastRowRWM, 7) = shC.Cells(LastRowRWM, 7) + ShA.Cells(k, 17) * 1000 * shB.Cells(h, 4) / shB.Cells(FinishedGMID + 2, 3) shC.Cells(LastRowRWM, 8) = shC.Cells(LastRowRWM, 8) + ShA.Cells(k, 19) * 1000 * shB.Cells(h, 4) / shB.Cells(FinishedGMID + 2, 3) shC.Cells(LastRowRWM, 9) = shC.Cells(LastRowRWM, 9) + ShA.Cells(k, 21) * 1000 * shB.Cells(h, 4) / shB.Cells(FinishedGMID + 2, 3) shC.Range(Cells(LastRowRWM - 1, 1), Cells(LastRowRWM - 1, 9)).Copy shC.Range(Cells(LastRowRWM, 1), Cells(LastRowRWM, 9)).PasteSpecial Paste:=xlPasteFormats 'Application.CutCopyMode = False LastRowRWM = LastRowRWM + 1 End If End If Next h End If Next k With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic .CutCopyMode = False End With End Sub Hopes this helps .... Per "Valeria" skrev i meddelelsen ... Dear experts, I have a long code (below) with many loopings to match cell values and long data lists, which is causing my code to be extremely slow (1 h) I am sure there is a better and faster way to do this... itwould be great if you could help me! Many thanks in advance. Best regards -- Valeria Sub RawMatConsumption() Dim FillIn As Integer, Length As Integer, LastRowSales As Integer, LastRowBOMS As Integer, i As Integer, k As Integer, g As Integer, h As Integer, FinishedGMID As Integer, Row1 As Integer, FirstGMIDRow As Integer, LastGMIDRow As Integer, LastRowRWM As Integer Dim mc As Range Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False 'for some reason the xllastcell does not work correctly here so I am looping to find the last cell i = 1 Do i = i + 1 Loop Until Worksheets("Sales Forecast").Cells(i, 1) = "Account Manager" Row1 = i + 1 i = Row1 Do i = i + 1 Loop Until Worksheets("Sales Forecast").Cells(i, 2) = "" LastRowSales = i i = 1 Do i = i + 1 Loop Until Worksheets("Raw Materials Forecast").Cells(i, 3) = "" LastRowRWM = i 'Last Row on BOMS Set mc = Worksheets("BOMS").Cells.SpecialCells(xlCellTypeLa stCell) LastRowBOMS = mc.Row 'to obtain a 8 digit text to be able to compare with the other data For i = 1 To LastRowBOMS If IsNumeric(Worksheets("BOMS").Cells(i, 1)) = True Then Worksheets("BOMS").Cells(i, 1).NumberFormat = "@" If Len(Worksheets("BOMS").Cells(i, 1)) < 8 Then If Len(Worksheets("BOMS").Cells(i, 1)) = 7 Then Worksheets("BOMS").Cells(i, 1) = "0" & Worksheets("BOMS").Cells(i, 1) ElseIf Len(Worksheets("BOMS").Cells(i, 1)) = 6 Then Worksheets("BOMS").Cells(i, 1) = "00" & Worksheets("BOMS").Cells(i, 1) ElseIf Len(Worksheets("BOMS").Cells(i, 1)) = 5 Then Worksheets("BOMS").Cells(i, 1) = "000" & Worksheets("BOMS").Cells(i, 1) End If End If End If Next i For i = 1 To LastRowRWM If IsNumeric(Worksheets("Raw Materials Forecast").Cells(i, 4)) = True Then Worksheets("Raw Materials Forecast").Cells(i, 4).NumberFormat = "@" If Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) < 8 Then If Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) = 7 Then Worksheets("Raw Materials Forecast").Cells(i, 4) = "0" & Worksheets("Raw Materials Forecast").Cells(i, 4) ElseIf Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) = 6 Then Worksheets("Raw Materials Forecast").Cells(i, 4) = "00" & Worksheets("Raw Materials Forecast").Cells(i, 4) ElseIf Len(Worksheets("Raw Materials Forecast").Cells(i, 4)) = 5 Then Worksheets("Raw Materials Forecast").Cells(i, 4) = "000" & Worksheets("Raw Materials Forecast").Cells(i, 4) End If End If End If Next i 'Put on the left the finished product GMID (=blue) Worksheets("BOMS").Columns(1).Insert Shift:=xlToRight For i = 1 To LastRowBOMS If Worksheets("BOMS").Cells(i, 2).Font.ColorIndex = 5 Then Worksheets("BOMS").Cells(i, 1) = Worksheets("BOMS").Cells(i, 2) Worksheets("BOMS").Cells(i, 2).ClearContents End If Next i 'Look for the BOM of the GMIDs Worksheets("Sales Forecast").AutoFilterMode = False 'this is where it starts to be extremely slow.... For k = Row1 To LastRowSales i = 1 Do i = i + 1 Loop Until Worksheets("Sales Forecast").Cells(k, 7) = Worksheets("BOMS").Cells(i, 1) Or i LastRowBOMS If i < LastRowBOMS Then FinishedGMID = i FirstGMIDRow = i + 4 Do i = i + 1 Loop Until IsEmpty(Worksheets("BOMS").Cells(i, 1)) = False Or i LastRowBOMS If i < LastRowBOMS Then LastGMIDRow = i - 4 Else LastGMIDRow = i End If For h = FirstGMIDRow To LastGMIDRow i = 1 Do i = i + 1 Loop Until Worksheets("BOMS").Cells(i, 1) = Worksheets("BOMS").Cells(h, 2) Or i LastRowBOMS If i < LastRowBOMS Then 'what to do when the rwm is not the real raw mat? Still in progress Else g = 1 Do g = g + 1 Loop Until Worksheets("Raw Materials Forecast").Cells(g, 4) = Worksheets("BOMS").Cells(h, 2) Or g LastRowRWM If g < LastRowRWM Then Worksheets("Raw Materials Forecast").Cells(g, 7) = Worksheets("Raw Materials Forecast").Cells(g, 7) + Worksheets("Sales Forecast").Cells(k, 17) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(g, 8) = Worksheets("Raw Materials Forecast").Cells(g, 8) + Worksheets("Sales Forecast").Cells(k, 19) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(g, 9) = Worksheets("Raw Materials Forecast").Cells(g, 9) + Worksheets("Sales Forecast").Cells(k, 21) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Else Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 4) = Worksheets("BOMS").Cells(h, 2) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 5) = Worksheets("BOMS").Cells(h, 3) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 6) = Worksheets("BOMS").Cells(FirstGMIDRow - 2, 4) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 7) = Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 7) + Worksheets("Sales Forecast").Cells(k, 17) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 8) = Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 8) + Worksheets("Sales Forecast").Cells(k, 19) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 9) = Worksheets("Raw Materials Forecast").Cells(LastRowRWM, 9) + Worksheets("Sales Forecast").Cells(k, 21) * 1000 * Worksheets("BOMS").Cells(h, 4) / Worksheets("BOMS").Cells(FinishedGMID + 2, 3) Worksheets("Raw Materials Forecast").Range(Cells(LastRowRWM - 1, 1), Cells(LastRowRWM - 1, 9)).Copy Worksheets("Raw Materials Forecast").Range(Cells(LastRowRWM, 1), Cells(LastRowRWM, 9)).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False LastRowRWM = LastRowRWM + 1 End If End If Next h End If Next k Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic End Sub |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
slow code with many loopings
huh, long code, just few ideas
to format number with leading zeroes, use numberformat="0000000#" 'worksheets' function searchs allways again, with each cell for worksheet, instead use: dim c1 as range c1=worksheets("raw material forecast").cells(i,4) if c1= ... "Valeria" je napisao u poruci interesnoj ... I have a long code (below) with many loopings to match cell values and long data lists, which is causing my code to be extremely slow (1 h) Worksheets("BOMS").Cells(i, 1).NumberFormat = "@" If Len(Worksheets("BOMS").Cells(i, 1)) < 8 Then If Len(Worksheets("BOMS").Cells(i, 1)) = 7 Then Worksheets("BOMS").Cells(i, 1) = "0" & Worksheets("BOMS").Cells(i, 1) For i = 1 To LastRowRWM If IsNumeric(Worksheets("Raw Materials Forecast").Cells(i, 4)) = True Then |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
slow code with many loopings
"sali" je napisao u poruci interesnoj
... huh, long code, just few ideas dim c1 as range c1=worksheets("raw material forecast").cells(i,4) if c1= ... just to correct, 'c1=' has to be 'set c1=', since c1 is object/range |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
slow code with many loopings
|
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Fast code in 2003 = agonizingly slow code in 2007 | Excel Programming | |||
| Slow code | Excel Programming | |||
| very slow code | Excel Programming | |||
| Slow code when used as VBA code instead of macro (copying visible columns) | Excel Programming | |||
| Slow Code | Excel Programming | |||
Hybrid Mode
