[Resolved]Speeding it up?!?

[direktoren]

Hi all you wiz'es

I'm done with a macro at work, but need to test it completely with different values and options in the sheet - however this takes a LONG time since my macro is running on brute force!

Sub Start()
Dim iSheet As Worksheet
Dim kSheet As Worksheet
Dim n As Long
Dim j As Long
    
Application.ScreenUpdating = False
    
    Set iSheet = ActiveWorkbook.Sheets("Input")
    Set kSheet = ActiveWorkbook.Sheets("Konstante")
    
    For n = 1 To 15000
        For j = 1 To 300
            If kSheet.Cells(j, "A").Value = iSheet.Cells(n, "M").Value Then
                iSheet.Cells(n, "N").Value = kSheet.Cells(j, "B").Value
            End If
            If kSheet.Cells(j, "A").Value = iSheet.Cells(n, "N").Value Then
                iSheet.Cells(n, "O").Value = kSheet.Cells(j, "B").Value
            End If
            If kSheet.Cells(j, "A").Value = iSheet.Cells(n, "F").Value Then
                iSheet.Cells(n, "P").Value = kSheet.Cells(j, "B").Value
            End If
            If kSheet.Cells(j, "C").Value = iSheet.Cells(n, "F").Value Then
                iSheet.Cells(n, "AF").Value = kSheet.Cells(j, "D").Value
            End If
            iSheet.Cells(n, "AG").Value = iSheet.Cells(n, "AE").Value & iSheet.Cells(n, "AF").Value
            If kSheet.Cells(j, "A").Value = iSheet.Cells(n, "AG").Value Then
                kSheet.Activate
                kSheet.Range(Cells(j, "B"), Cells(j, "O")).Copy
                iSheet.Activate
                iSheet.Range(Cells(n, "Q"), Cells(n, "AD")).PasteSpecial Paste:=xlValues
                Application.CutCopyMode = False
            End If
        Next j
    Next n
        
    Set iSheet = Nothing
    Set kSheet = Nothing
 
Application.ScreenUpdating = True
End Sub

The final macro is made up with 12 of these subcommands and a complete test takes 6500 secs! (that's 1h 48m 20s!!) - since I need to test it with a lot of different combinations I would like to speed up the process!

Is this possible??

thanx
/nick

[DKenny]

Nick
Let's start by changing this section of code.

If kSheet.Cells(j, "A").Value = iSheet.Cells(n, "AG").Value Then
    kSheet.Activate
    kSheet.Range(Cells(j, "B"), Cells(j, "O")).Copy
    iSheet.Activate
    iSheet.Range(Cells(n, "Q"), Cells(n, "AD")).PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False
End If

Activating sheets and copying data in this way is going to be really slow. You can achieve the same result without having to switch between sheets, using the following code.

If kSheet.Cells(j, "A").Value = iSheet.Cells(n, "AG").Value Then
    iSheet.Range(Cells(n, "Q"), Cells(n, "AD")).Value = kSheet.Range(Cells(j, "B"), Cells(j, "O")).Value
End If

This may be enough to get the performance to where you want it, so lets try that. Time it, and if you still need more we can try some other optimizations.

[direktoren]

Hi Kenny

Thanx, didn't even look at that one - it helped a bit...However the of my subcommands looks like the one posted except, with those the copying formats are a bit different (some are value, som are transpose, som have skipblanks etc. most are a mix), so I don't think i can equal those ones...

Anything else up your sleeve?

[DKenny]

Can you upload a copy of the workbook?
We should be able to get rid of one of the loops (either j or n) which should speed the process up significantly. I would like to see the structure to determine which loop tp remove.

[Webtest]

Nick ...

You are probably doing a LOT of extra tests.

Will more than ONE constant be matched for Input Columns "M", "N", or "F"? If only one constant will be matched, you should use an "ElseIf" construct to bypass the unneeded comparison tests.

If you have long strings that can be absolutely identified from the first few characters, only use as few of the first characters as are needed to make the identification.

How many rows from the Konstante Sheet will be used for any SINGLE row of the Eingang sheet? If there is only ONE Konstante row that matches any Input row then you can abort the "j" loop once the correct Konstante row has been found. I usually use a Boolean to do this:

Dim found As Boolean

'Initialize FOUND flag to NOT FOUND
found = False
For j = 1 To 300
    If mytest Then
        'Everywhere the test passes, do this:
        found = True
        'If only one test can ever pass, also do this immediately
        Exit For
    End If
    
    'If the results of more than one test must be processed, at the END of the "j" loop do this:
    If found Then Exit For
Next j

If found Then
    'Process "Test Passed' Here
Else
    'Process "Test Failed' Here
End If

'  ... continue processing "n" loop

[Webtest]

Nick ...

Also, I have a hunch that if you use a Dictionary lookup for your Konstants it will be faster (???) than scanning the kSheet for each row in the iSheet. Do any of the Konstants in Column C ALSO appear in Column A? That makes a big difference in how I would approach the code.

You can build the Dictionary Keys automatically from the kSheet, but writing the code to initialize 300 or 600 constants will be a royal pain. But then you only have to do it once!

If you answer this question as well as the ones from my previous post regarding "how many tested constants can be mapped from rows M, N, and F on the iSheet?", we may be able to get this thing to run a lot faster.

[VBAhack]

For what you are doing it seems to me you could read the ranges into arrays, do all of the processing on the arrays, then write the arrays back to the spreadsheet when you are done. Arrays are very fast. Also, you should use integers instead of longs for the index.

Dim n As Integer, j As Integer
    Dim iArray As Variant, kArray As Variant
    
    With ActiveWorkbook
        iArray = .Sheets("Input").Range("A1:M15000")
        kArray = .Sheets("Konstante").Range("A1:M15000")
    End With
    
     For n = 1 To 15000
        For j = 1 To 300
            If kArray(j, 1) = iArray(n, 13) Then iArray(n,12) = kArray(j, 2)
            'other stuff
        Next j
    Next n
    
    With ActiveWorkbook
        .Sheets("Input").Range("A1:M15000") = iArray
        .Sheets("Konstante").Range("A1:M15000") = kArray
    End With

[Webtest]

VBAhack ...

That was going to be a part of my suggestion ... the Dictionary Key/Value pair could consist of the Constants as Keys, and the Value could consist of the index into a pair of arrays ... one for which column to store the Constant "B" cell, and the the second with the *>edit B actual values. There is a built-in function to determine if a Key exists that could simplify the string testing.

Using Integers for Row numbers is not guaranteed (I know in this case we have been told there are only 15000 rows) since the number of rows possible is 65536 ... this overflows an Integer. I've also seen reports that it actually can take longer to access 16 bit integers since native memory accesses are 32 bits (I can't swear to this).

[VBAhack]

I've also seen reports that it actually can take longer to access 16 bit integers since native memory accesses are 32 bits

Yeah, I remember seeing something similar. Easy way to find out - try both and time it.

[direktoren]

Thanx for all the good advice

Now for the questions regarding them...

DKenny --> I had to go back to the copy paste instead of equalling the cells, because even though I'm using .value it is copying the formula in the cell, instead of the value - therefore back to pastespecial with xlvalue. I'm btw not able to upload the workbook, first off, the figures in it are confidential so i would have to make up a lot of fake figures, and second it's huge - the workbook is 24,7 MB...

VBAHack --> Tried using your idea with the arrays, it was so much faster, BUT for some odd reason it's not working - u see, it's not copying the cells, so I can't use it for that much (Is there something I have missed?)

Webtest --> Not more than one constant from the kSheet will be matched by M, N and F (meaning there is a separate constant for each of them). And yes the Konstants in column C matches some of those from column A, but they yield different outputs (this is why I moved them to "C" - to avoid finding the wrong constant).

Hope this explains it a bit - especially hoping to hear from you hack, since it did go a lot faster that way (it went from 17 minutes, to 11 sek!)

Regards
Nick

[Webtest]

Nick ... I'm still not sure I understand.

If you find a match for "M" are you done with testing for that row or do you STILL have to check "N" and "F"?

If you do NOT find a match for "M" but you DO find a match for "N" are you done with testing for that row or do you STILL need to check for "F"?

[direktoren]

Well it's a bit tricky to explain, but let me try in simple terms;

for the sake of ease, k=ksheet and i=isheet.

if iM=kA then iN=kB --> if iN=kA then iO=kB (so these 2 processes are linked, because N is blank until the macro has been runned)

unaffected by this I've got

if iF=kA then iP=kB

Later on I then have

if iF=kC then iAF=kD (this constant is situated in kC because the same values are figurating in kA --> thus to get the right result I've moved it...

So answering your question in short; Yes, When I find a match for M I still need to find a match for both N and F.

/Nick

[VBAhack]

VBAHack --> Tried using your idea with the arrays, it was so much faster, BUT for some odd reason it's not working - u see, it's not copying the cells, so I can't use it for that much (Is there something I have missed?)

Very strange. I just did a test where I opened a brand new workbook, pasted the following into a new code module, and executed it. Result was cells on sheets 1 and 2 where modified. Total execution time was about 2 sec.

Sub GoodTest()
    Dim n As Integer, j As Integer
    Dim iArray As Variant, kArray As Variant
    
    With ActiveWorkbook            'read ranges into arrays
        iArray = .Sheets("Sheet1").Range("A1:M15000")
        kArray = .Sheets("Sheet2").Range("A1:M15000")
    End With
    
     For n = 1 To 15000    'modify array values
        For j = 1 To 300
            kArray(j, 1) = n + j
            iArray(n, 5) = n - j
        Next j
    Next n
    
    With ActiveWorkbook             'write arrays back out to cells
        .Sheets("Sheet1").Range("A1:M15000") = iArray
        .Sheets("Sheet2").Range("A1:M15000") = kArray
    End With
End Sub

[direktoren]

I don't get it either...

My code looks like this:

Sub Star()
Dim iArray As Variant
Dim kArray As Variant
Dim n As Long
Dim j As Long
 
With ActiveWorkbook
    iArray = .Sheets("Input").Range("A1:AM15000")
    kArray = .Sheets("Konstante").Range("A1:T15000")
End With
    
    For n = 1 To 15000
        For j = 1 To 300
            If kArray(j, 1) = iArray(n, 13) Then
                iArray(n, 14) = kArray(j, 2)
            End If
            If kArray(j, 1) = iArray(n, 14) Then
                iArray(n, 15) = kArray(j, 2)
            End If
            If kArray(j, 1) = iArray(n, 6) Then
                iArray(n, 16) = kArray(j, 2)
            End If
            If kArray(j, 3) = iArray(n, 6) Then
                iArray(n, 32) = kArray(j, 4)
            End If
        Next j
    Next n
        
With ActiveWorkbook
    .Sheets("Input").Range("A1:M15000") = iArray
    .Sheets("Konstante").Range("A1:M15000") = kArray
End With
 
End Sub

I was thrilled when I ran it - timed it at 10,4 sec, but then I wanted to start testing and found out that it didn't copy anything between the arrays, thus making its speed rather useless!

[RobDog888]

Turn screenupdating off before its executed and back on when its do. This should help since it wont have to update the screen display for every cell change.

Application.ScreenUpdating = False
'Do stuff
Application.ScreenUpdating = True

[direktoren]

Thanx Rob - but as you can see at my initial post, I already have turned it off. But now I'm trying to follow VBAHacks advise (using arrays instead of ranges), but I can't get it to work properly...

[RobDog888]

Sorry I missed it but I did read all the posts, probably just forgot after 14 posts lol.

Post your new issue.

[direktoren]

Well my new issue is post #14...I tried using VBAHacks advise, array instead of ranges, but although it is superfast, I can't get it to copy anything! which is kind of what I need it to do, so right now I'm still using the code I posted in #1 - but what I would like is to get the Arrays working...

[Webtest]

Nick ...
Do a "sanity" check like this ... open the View > Immediate window ... and manually compare the 100 lines that you get. If the comparisons don't fly, you won't get any of your target cells loaded!

    For n = 1 To 10
        For j = 1 To 10

            'TEST TEST TEST TEST
            Debug.Print kArray(j,1), iArray(n,13), iArray(n,14), iArray(n,6), kArray(j,3)
            'END TEST

            If kArray(j, 1) = iArray(n, 13) Then
                iArray(n, 14) = kArray(j, 2)
            End If
            If kArray(j, 1) = iArray(n, 14) Then
                iArray(n, 15) = kArray(j, 2)
            End If
            If kArray(j, 1) = iArray(n, 6) Then
                iArray(n, 16) = kArray(j, 2)
            End If
            If kArray(j, 3) = iArray(n, 6) Then
                iArray(n, 32) = kArray(j, 4)
            End If
        Next j
    Next n

[VBAhack]

I noticed that you are writing to different ranges than you are reading into the arrays. They need to match:

With ActiveWorkbook
    iArray = .Sheets("Input").Range("A1:AM15000")
    kArray = .Sheets("Konstante").Range("A1:T15000")
End With
        
With ActiveWorkbook
    .Sheets("Input").Range("A1:M15000") = iArray      ' should be A1:AM15000
    .Sheets("Konstante").Range("A1:M15000") = kArray  'should be A1:T15000
End With

This might be your problem.

[direktoren]

OMG - That was it!

Thanx Hack, Guess I will be remembering to double check my script from now on....

/Nick

[VBAhack]

Glad to hear you got it working. If you wanted to expend more energy, you might be able to get some incremental improvements by, for example, using Integer instead of Long for the index (keeping in mind the comments by Webtest), and/or implementing speed tips such as ones found:

http://www.vbforums.com/showthread.php?t=264351
http://www.aivosto.com/vbtips/stringopt.html
http://www.planet-source-code.com/vb...34787&lngWId=1
http://www.persistentrealities.com/v...egory=1&item=0