Optimizing VBA

I created this VBA code:

Code:

---

Sub macro1()
    Dim i As Long, Texto As String, j As Long
    For i = 1 To Range("K65536").End(xlUp).Row
        Range("K" & i).Select
        Select Case ActiveCell.Value
            Case 0
                ActiveCell.Offset(0, 1).Select
                ActiveCell.Value = "Ok"
            Case Is < 0
                ActiveCell.Offset(0, 1).Select
                ActiveCell.Value = "Under"
            Case Else
                Texto = Range("B" & i).Value & Range("D" & i).Value
                With Sheets("Class 2")
                    For j = 2 To .Range("A65536").End(xlUp).Row
                        If (.Range("A" & j).Value & .Range("B" & j).Value) = Texto _
 And .Range("D" & j).Value = 0 Then
                                ActiveCell.Offset(0, 1).Select
                                ActiveCell.Value = "Above"
                                Exit For
                        End If
                    Next j
                End With
        End Select
    Next i
    Range("K1").Select
 End Sub

---

But its TOO slow. It takes 1 sec per row and as my sheet has 22,000 rows its TOO much.

Can anyone help me to optimize it?

:banghead: :banghead:

The first thing we can do is get rid of the selecting code which should speed it up a bit.

Code:

---

Option Explicit
 
 Sub macro1()
Dim i As Long, Texto As String, j As Long
For i = 1 To Range("K65536").End(xlUp).Row
        Select Case ActiveCell.Value
        Case 0
            Range("L" & i).Value = "Ok"
        Case Is < 0
            Range("L" & i).Value = "Under"
        Case Else
            Texto = Range("B" & i).Value & Range("D" & i).Value
            With Sheets("Class 2")
                For j = 2 To .Range("A65536").End(xlUp).Row
                    If (.Range("A" & j).Value & .Range("B" & j).Value) = Texto _
                        And .Range("D" & j).Value = 0 Then
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = "Above"
                    Exit For
                End If
            Next j
        End With
    End Select
 Next i
End Sub

---

Now instead of the j loop we can use .Find to find the cells we want which is much faster than a loop. If you need help with that can you post an attachment so I can see what is going on?

Hi Jake,

thanks. Could you post a small example code that uses .Find? Then I may try to adapt it. All I need is to concatenate cells B and D from a sheet and compare then to the cells A and B (concatenated) from another sheet. Then if they are equal I must test cell Ds value to see if its equal to zero.

Ok, see if this works. It's hard to tell without the data to test it.

Code:

---

Option Explicit
 
Sub macro1()
Dim i              As Long
Dim j              As Long
Dim Texto          As String
Dim LastRow        As Long
Dim SearchRange    As Range
Dim Cel            As Range
Dim FirstAddress    As String
LastRow = Range("K65536").End(xlUp).Row
    Set SearchRange = Sheets("Class 2").Range("A2:A" & _
    Sheets("Class 2").Range("A65536").End(xlUp).Row)
For i = 1 To LastRow
        Select Case Range("K" & i).Value
        Case Is = 0
            Range("L" & i).Value = "Ok"
        Case Is < 0
            Range("L" & i).Value = "Under"
        Case Else
            Texto = Range("B" & i).Text & Range("D" & i).Text
            With SearchRange
                Set Cel = .Find(What:=Range("B" & i).Text, LookIn:=xlValues, _
                LookAt:=xlWhole, MatchCase:=True)
                If Not Cel Is Nothing Then
                    FirstAddress = Cel.Address
                    Do
                        If Cel.Offset(0, 1).Text = Range("D" & i).Text And _
                        Sheets("Class 2").Range("D" & Cel.Row) = 0 Then
                        Range("L" & i).Value = "Above"
                        Exit Do
                    End If
                    Set Cel = .FindNext(Cel)
                Loop While Not Cel Is Nothing And Cel.Address <> FirstAddress
            End If
        End With
    End Select
 Next i
End Sub

---

Here is a closer look at how the search works.

Code:

---

'Basic with statement
With SearchRange
'This line sets the range Cel to the cell where our
'matching value is found.
'What:= what we are searching for.
'LookIn:= Either xlValues or xlFormulas depending on
'what we are seaching in.
'LookAt:= Either xlWhole to match the whole cell, or
'xlPart to match part of the cell.
Set Cel = .Find(What:=Range("B" & i).Text, LookIn:=xlValues, _
    LookAt:=xlWhole, MatchCase:=True)
'If there is no match the Cel would be nothing so we
'check with an If statement.
If Not Cel Is Nothing Then
'We store the address of Cel for later use since we don't
'want to infinitely search.
FirstAddress = Cel.Address
'Start of a Do...Loop loop.
        Do
'We already matched Range("B" & i).Text so we need
'to check if the next cell over
'matches Range ("D" & i).Text. We also want to check
'if the value in Column D corresponding to where Cel
'was found is equal to 0.
If Cel.Offset(0, 1).Text = Range("D" & i).Text And _
            Sheets("Class 2").Range("D" & Cel.Row) = 0 Then
'True part of the If statement. This puts the value Above
'in Range("L" & i).
Range("L" & i).Value = "Above"
'Exit the Do...Loop loop since we only need one match.
                Exit Do
            End If
In case we matched Range("B" & i).Text but not
'Range("D" & i).Text we need to find the next matching value.
Set Cel = .FindNext(Cel)
'This will loop through all the matching values of our search.
'If Cel is nothing then there are no matches.
'If Cel.Address = FirstAddress then we found all the cells and
'would now start over. In either case the loop ends.
Loop While Not Cel Is Nothing And Cel.Address <> FirstAddress
    End If
End With

---

Don't forget, if you also turn off Events and ScreenUpdating, it should speed your code up slightly also ...

Code:

---

Application.EnableEvents = False
Application.ScreenUpdating = False
'...
'...
'turn back on
Application.EnableEvents = True
Application.ScreenUpdating = True

---

Great guys,

I believe this is gonna work great. Thanks Jake and Zack. I will test it and post the result here. BRB

Hi guys,

well it worked fine but still slow for 22,000 rows. Anything else that may make it faster?
It takes me 38 min and 22 secs.

Well, looping through that many cells will take a very long time. If there is a way you can use AutoFilter, do it. It's very fast.

Hi Zack,

unfortunatelly I cant use autofilter because I have to treat in a different way cells that have the same result. My judgement will depend on values from 3-7 cells on each row. It takes 38:22 and I have no clue on how to make it faster. I have take select case off and put an if, disabled screenupdating and events but it still slow.

Any suggestions?

Well we are still using a huge loop so that will be slow. You can also turn off Automatic Calculations while your code is running. That may shave some more time.

But the big problem is the main loop.

I think I might have another idea for you. I'll try to write it up later tonight.

Hi Paleo,

Jake's right, there's too many "select"s in there. You don't have to select a cell to assign a value to it, in fact I don't think you even need to specify "value" in this case either (as - due to the context in which it's being used - it's assumed you're referring to the value in the specified cell anyway).

See if this helps, it's your original code, but abridged. Admittedly I dont have data in the cells, but when I set it to 20000 rows, with my old 233MHz machine it took 30-35 secs to cycle through, and, when Events were also turned off as Zack suggested, it took 25 secs.

Code:

---

Sub macro1()
Dim i As Long, Texto As String, j As Long
Application.ScreenUpdating = False
For i = 1 To Range("K65536").End(xlUp).Row
Range("K" & i).Select
Select Case ActiveCell
Case 0
ActiveCell.Offset(0, 1) = "Ok"
Case Is < 0
ActiveCell.Offset(0, 1) = "Under"
Case Else
Texto = Range("B" & i) & Range("D" & i)
With Sheets("Class 2")
For j = 2 To .Range("A65536").End(xlUp).Row
If (.Range("A" & j) & .Range("B" & j)) = Texto _
And .Range("D" & j) = 0 Then
ActiveCell.Offset(0, 1) = "Above"
Exit For
End If
Next j
End With
End Select
Next i
Range("K1").Select
End Sub

---

Quote:

---

Originally Posted by Paleo

I have no clue on how to make it faster.

---

Let me know how fast this code runs.

Code:

---

Option Explicit
   
  Sub macro1()
Dim i              As Long
      Dim j              As Long
      Dim Texto          As String
      Dim LastRow        As Long
      Dim SearchRange    As Range
      Dim Cel            As Range
      Dim FirstAddress    As String
      Dim RngOK          As Range
      Dim RngAbove        As Range
      Dim RngUnder        As Range
      Dim RngTemp        As Range
Application.ScreenUpdating = False
      Application.EnableEvents = False
LastRow = Range("K65536").End(xlUp).Row
      Set SearchRange = Sheets("Class 2").Range("A2:A" & _
      Sheets("Class 2").Range("A65536").End(xlUp).Row)
'This needs to be an unused cell.
      Set RngTemp = Range("Z1")
      Set RngOK = RngTemp
      Set RngAbove = RngTemp
      Set RngUnder = RngTemp
      For i = 1 To LastRow
          Select Case Range("K" & i).Value
          Case Is = 0
              Set RngOK = Union(RngOK, Range("L" & i))
          Case Is < 0
              Set RngUnder = Union(RngUnder, Range("L" & i))
          Case Else
              Texto = Range("B" & i).Text & Range("D" & i).Text
              With SearchRange
                  Set Cel = .Find(What:=Range("B" & i).Text, LookIn:=xlValues, _
                  LookAt:=xlWhole, MatchCase:=True)
                  If Not Cel Is Nothing Then
                      FirstAddress = Cel.Address
                      Do
                          If Cel.Offset(0, 1).Text = Range("D" & i).Text And _
                              Sheets("Class 2").Range("D" & Cel.Row) = 0 Then
                              Set RngAbove = Union(RngAbove, Range("L" & i))
                              Exit Do
                          End If
                          Set Cel = .FindNext(Cel)
                      Loop While Not Cel Is Nothing And Cel.Address <> FirstAddress
                  End If
              End With
          End Select
      Next i
RngOK.Value = "Ok"
      RngUnder.Value = "Under"
      RngAbove.Value = "Above"
      RngTemp.ClearContents
Set RngOK = Nothing
      Set RngUnder = Nothing
      Set RngAbove = Nothing
      Set RngTemp = Nothing
      Set SearchRange = Nothing
      Set Cel = Nothing
Application.ScreenUpdating = True
      Application.EnableEvents = True
End Sub

---

Hi guys,

johnske's code runned on 14:27 (an acceptable time) and jake's on more than 45 minutes (when I gave up, sorry!). The machine is a Pentium 4, 2.66 Ghz and 512 Mb RAM.

Hi Jack,



well this time I have waited. 46:26.

Frankly, am surprised - the inbuilt Find function is usually much faster

Ok, this is the last thing I can think of to speed it up. We can get rid of the second loop completely and use AutoFill instead. Assuming Column Z on Class 2 is not used.

Code:

---

Option Explicit
 
 Sub macro1()
Dim i              As Long
    Dim j              As Long
    Dim Texto          As String
    Dim LastRow        As Long
    Dim SearchRange    As Range
    Dim Cel            As Range
    Dim FirstAddress    As String
    Dim RngOK          As Range
    Dim RngAbove        As Range
    Dim RngUnder        As Range
    Dim RngTemp        As Range
    Dim n              As Long
Application.ScreenUpdating = False
    Application.EnableEvents = False
LastRow = Range("K65536").End(xlUp).Row
    n = Sheets("Class 2").Range("A65536").End(xlUp).Row
    Set SearchRange = Sheets("Class 2").Range("Z2:Z" & n)
Sheets("Class 2").Range("Z2").Value = Sheets("Class 2").Range("A2").Value & _
    Sheets("Class 2").Range("B2").Value
Sheets("Class 2").Range("Z2").AutoFill Destination:= _
    Sheets("Class 2").Range("Z2:Z" & n), Type:=xlDefault
'This needs to be an unused cell.
    Set RngTemp = Range("Z1")
    Set RngOK = RngTemp
    Set RngAbove = RngTemp
    Set RngUnder = RngTemp
    For i = 1 To LastRow
        Select Case Range("K" & i).Value
        Case Is = 0
            Set RngOK = Union(RngOK, Range("L" & i))
        Case Is < 0
            Set RngUnder = Union(RngUnder, Range("L" & i))
        Case Else
            Texto = Range("B" & i).Text & Range("D" & i).Text
            With SearchRange
                Set Cel = .Find(What:=Texto, LookIn:=xlValues, _
                LookAt:=xlWhole, MatchCase:=True)
                If Not Cel Is Nothing And Sheets("Class 2").Range("D" & Cel.Row) = 0 Then
                    Set RngAbove = Union(RngAbove, Range("L" & i))
                End If
            End With
        End Select
    Next i
RngOK.Value = "Ok"
 RngUnder.Value = "Under"
 RngAbove.Value = "Above"
 RngTemp.ClearContents
 SearchRange.ClearContents
Set RngOK = Nothing
 Set RngUnder = Nothing
 Set RngAbove = Nothing
 Set RngTemp = Nothing
 Set SearchRange = Nothing
 Set Cel = Nothing
Application.ScreenUpdating = True
 Application.EnableEvents = True
End Sub

---

And this is the last thing I can think of on these lines - getting rid of the only remaining "Select" appears to shave about 20 to 30% off the time...

Code:

---

Sub macro2()
      Dim i As Long, Texto As String, j As Long
      '//allow the "macros" form to be unloaded
      DoEvents
      '//now disable further events
      Application.EnableEvents = False
      Application.ScreenUpdating = False
      For i = 1 To Range("K65536").End(xlUp).Row
            With Range("K" & i)
                  Select Case Range("K" & i)
                  Case 0
                        Range("K" & i).Offset(0, 1) = "Ok"
                  Case Is < 0
                        Range("K" & i).Offset(0, 1) = "Under"
                  Case Else
                        Texto = Range("B" & i) & Range("D" & i)
                        With Sheets("Class 2")
                              For j = 2 To .Range("A65536").End(xlUp).Row
                                    If (.Range("A" & i) & .Range("B" & i)) = Texto _
                                      And .Range("D" & i) = 0 Then
                                          Range("K" & i).Offset(0, 1) = "Above"
                                          Exit For
                                    End If
                              Next j
                        End With
                  End Select
            End With
      Next i
      Range("K1").Select
      '//re-enable events
      Application.EnableEvents = True
      Application.ScreenUpdating = True
End Sub

---

Hi John,



your approach have increased performance a little more and I think Jakes approach is gonna be great if I classify data before it. What do you think Jake?

Quote:

---

Originally Posted by Paleo

Hi John,



your approach have increased performance a little more and I think Jakes approach is gonna be great if I classify data before it. What do you think Jake?

---

Pal,

Can I try?

Could someone post a workbook version of this so I don't have to spend an hour digesting and reconstructing?

Quote:

---

Originally Posted by Paleo

I think Jakes approach is gonna be great if I classify data before it. What do you think Jake?

---

:what: Not sure what you mean.

I thought if I classify a column data in ascending order before using the find command, it would make the code run faster. Right?

Try now: This seems to be faster again, but without real data to try it on I can't double-check to see if the results are correct...("If"s appeared to be the same speed as using "Case", but changing to "ElseIf"s seems to make it a little faster. i.e. "If"s take 50% more time than "ElseIf"s for 20000 rows on a blank sheet)...

Code:

---

Sub macro2()
Dim i As Integer
'//allow the "macros" form to be unloaded
DoEvents
'//now disable further events
Application.EnableEvents = False
Application.ScreenUpdating = False
For i = 1 To Range("K65536").End(xlUp).Row
With Range("K" & i)
If Range("K" & i) = 0 Then
Range("L" & i) = "Ok"
ElseIf Range("K" & i) < 0 Then
Range("L" & i) = "Under"
ElseIf Range("K" & i) > 0 Then
If (Range("A" & i) & Range("B" & i)) = Range("B" & i) & Range("D" & i) And _
Range("D" & i) = 0 Then Range("L" & i) = "Above"
End If
End With
Next i
Range("K1").Select
'//re-enable events
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

---

PS: Also, delete the With and End With lines - they're redundant, and with such a large number of iterations they just waste processing time...

Hi John,

it got faster, yes, 10:06. But didnt write the "Above". I will check to code to see what got wrong.

The code I am using right now is:

Code:

---

Sub test()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim i As Long, Texto As String, j As Long, UltLin As Long
    Dim AreaBusca As Range, cel As Range, PriLin As String
    For i = 2 To Range("K65536").End(xlUp).Row
    Range("L1") = "Grades"
    UltLin = Range("K65536").End(xlUp).Row
    Set AreaBusca = Sheets("Standard").Range("A2:A" & _
        Sheets("Standard").Range("A65536").End(xlUp).Row)
If Range("K" & i) = 0 Then
                Range("L" & i) = "Ok"
        ElseIf Range("K" & i) < 0 Then
                Range("L" & i) = "Below"
        Else
                Texto = Range("B" & i) & Range("D" & i)
                With AreaBusca
                    Set cel = .Find(What:=Range("B" & i).text, LookIn:=xlValues, _
                        LookAt:=xlWhole, MatchCase:=True)
                    If Not cel Is Nothing Then
                        PriLin = cel.Address
                        Do
                            If cel.Offset(0, 1).text = Range("D" & i).text And _
                            Sheets("Standard").Range("D" & cel.Row) = 0 Then
                            Range("L" & i) = "To Check"
                            Exit Do
                        End If
                        Set cel = .FindNext(cel)
                        Loop While Not cel Is Nothing And cel.Address <> PriLin
                    End If
                End With
If ActiveCell.Offset(0, -1).Value < ActiveCell.Offset(0, -3).Value And _
                    ActiveCell.Offset(0, 1).Value = "" Then
                    Range("L" & i) = "Above"
                End If
        End If
    Next i
    Range("K1").Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

---

Quote:

---

Originally Posted by Paleo

I thought if I classify a column data in ascending order before using the find command, it would make the code run faster. Right?

---

No, it wouldn't really matter. Find is very fast to begin with.

Did you run my last code. It should be very fast. 20,000 iterations with a single Select Case and a Find for one of the Cases should be very fast. Also the data is only written once. I can't imagine that this would take more than a couple of minutes to run.

Email me the workbook so I can take a look at what is going on.

Quote:

---

Originally Posted by DRJ

No, it wouldn't really matter. Find is very fast to begin with.

Did you run my last code. It should be very fast. 20,000 iterations with a single Select Case and a Find for one of the Cases should be very fast. Also the data is only written once. I can't imagine that this would take more than a couple of minutes to run.

Email me the workbook so I can take a look at what is going on.

---

Agreed! As I said before, I'm surprised 'cos "Find" is by far the fastest method and this set me thinking....

You've got a fairly fast system, but I've seen even the most up-to-date you-beaut little ripper-bonza systems running much slower than my puny 233MHz machine (taking 2 or more times longer to do the same thing). I've cleaned up these machines and got them running as they should with a little "house-keeping", so can I make a suggestion or two?

If you dont already have it, click this link > ToniArts EasyCleaner then download and install EasyCleaner (it's free), then click "Unnecessary" and tick all the items in there - run it and delete all that's found. Then Click "Registry" and delete all the items found (dead links etc) in there. (It's amazing how much unnecessary junk can accumulate in your machine in just a few days, slowing it down and fragmenting the info on your hard-drive).

Now defrag...There are many defraggers around, the one I use personally is Diskeeper Lite (it's free also) - it's MUCH faster that the inbuilt one (Win97SE) and does a far better job. However I'm led to understand that Microsoft bought and uses the Diskeeper program in their latest versions of Windows so you may already have this installed...

After doing all this, try running the code again.

Regards,
John

Hi Jake,

the problem is that my spreadsheet has almost 100 Mb already. Yes, this function we are trying to make run faster is only one out of many others. Thats why I am only posting the code here and not attaching the file.

I will do what you suggested John, thanks.

Hi Paleo,

Well if you don't have any cleaners such as the one I suggested I think you will find this helps enormously...



BTW: Regarding the use of ElseIf:

Assume you have a number of conditions within a "For To - Next" loop

If you use a number of "If"s or "Case"s.... each individual If or Case statement must first be tested to see if it meets the condition you've given (i.e. basically, to see whether it's True or False) and may thus need to be acted upon before the code gets to "Next".

But if you use a number of "ElseIf"s.... the implication behind the use of ElseIf is that only ONE of these conditions can be true and as soon as one is found to be true and acted upon, the code can go almost directly to "Next".

So, if you put your most common case in the FIRST "If" statement (which always has to be tested anyway), the code can then go directly to the "Next" without needing to test the rest of the ElseIfs, where-as if you put the most common case in the LAST ElseIf, there is would be no gain in speed as all statements then have to be tested before reaching "Next".

Regards,
John

(I edited the above, I meant ElseIf, not IfThen)

Quote:

---

Originally Posted by Paleo

Hi Jake,

the problem is that my spreadsheet has almost 100 Mb already. Yes, this function we are trying to make run faster is only one out of many others.

---

For this code we are only dealing with two sheets right? Copy those two sheets to a new workbook and try to run this code too see how fast it runs.

Depending on what you are trying to do you may want to consider an alternative for your data storeage. Perhaps Access or some of the data can be stored in text files when not in use.

Quote:

---

Originally Posted by johnske

If you use a number of "If"s or "Case"s.... each individual If or Case statement must first be tested to see if it meets the condition you've given (i.e. basically, to see whether it's True or False) and may thus need to be acted upon before the code gets to "Next".

But if you use a number of "ElseIf"s.... the implication behind the use of ElseIf is that only ONE of these conditions can be true and as soon as one is found to be true and acted upon, the code can go almost directly to "Next".

---

The same is true for Select Case. Once a Case matches the criteria none of the other Cases are checked.

:oops: Yeah, Jake's right again (dammit)...:banghead: :bow:

Extract from the VBA Help files: >> the Select Case statement evaluates an expression only once, at the top of the control structure.

Ok, I will do it and after I post my results here.

Paleo

Were you able to test this?

Hi Jake,

sorry for the delay. Yes I have tested it in an isolated workbook. It took only 6 minutes. Then I tried to make it work together to the other subs and found out that the problem really happens when i mix them. So, now my problem is at another point, so i will close this tread and start another.

Thanks.

I am still curious as to why it would take 6 minutes to run. It really should not be that slow. Can you post the seperate workbook that you tested?

Hi Jake,

I wouldnt like to post the workbook. Can you send me your e-mail by pm? Then I send it to you.

I am not sure where the data is supposed to go, but give this a try. You may need to change the ranges.

Code:

---

Dim i              As Long
    Dim j              As Long
    Dim Texto          As String
    Dim LastRow        As Long
    Dim SearchRange    As Range
    Dim Cel            As Range
    Dim FirstAddress    As String
    Dim RngOK          As Range
    Dim RngAbove        As Range
    Dim RngUnder        As Range
    Dim RngTemp        As Range
    Dim n              As Long
    Dim MyTimer        As Double
MyTimer = Timer
Application.ScreenUpdating = False
    Application.EnableEvents = False
LastRow = Sheets("Standard").Range("A65536").End(xlUp).Row
    n = Sheets("NC_nov").Range("A65536").End(xlUp).Row
    Set SearchRange = Sheets("NC_nov").Range("Z2:Z" & n)
Sheets("NC_nov").Range("Z2").Value = "=A2 & B2"
Sheets("NC_nov").Range("Z2").AutoFill Destination:= _
    Sheets("NC_nov").Range("Z2:Z" & n), Type:=xlFillDefault
'This needs to be an unused cell.
    Set RngTemp = Sheets("Standard").Range("Z1")
    Set RngOK = RngTemp
    Set RngAbove = RngTemp
    Set RngUnder = RngTemp
    For i = 1 To LastRow
        Select Case Sheets("Standard").Range("F" & i).Value
        Case Is = 0
            Set RngOK = Union(RngOK, Sheets("Standard").Range("L" & i))
        Case Is < 0
            Set RngUnder = Union(RngUnder, Sheets("Standard").Range("L" & i))
        Case Else
            Texto = Sheets("Standard").Range("B" & i).Text & Sheets("Standard").Range("D" & i).Text
            With SearchRange
                Set Cel = .Find(What:=Texto, LookIn:=xlValues, _
                LookAt:=xlWhole, MatchCase:=True)
                If Not Cel Is Nothing Then
                    If Sheets("NC_nov").Range("D" & Cel.Row) = 0 Then
                        Set RngAbove = Union(RngAbove, Sheets("Standard").Range("L" & i))
                    End If
                End If
            End With
        End Select
Next i
RngOK.Value = "Ok"
    RngUnder.Value = "Under"
    RngAbove.Value = "Above"
    RngTemp.ClearContents
    SearchRange.ClearContents
Set RngOK = Nothing
    Set RngUnder = Nothing
    Set RngAbove = Nothing
    Set RngTemp = Nothing
    Set SearchRange = Nothing
    Set Cel = Nothing
Application.ScreenUpdating = True
    Application.EnableEvents = True
MsgBox Timer - MyTimer

---

Hi Jake,

ok, thanks, i will test it.

Hi Jake,

now this was FAST!!!!:thumb

The MessageBox showed 36,6158750000031

Great!!!
:bow: :bow: :beerchug: :bow: :bow: :beerchug: :bow: :bow: