Long but I'll try to help. Probably MUCH better ways to find what you are
looking for.
If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Valeria" wrote in message
...
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