Very slow loop excel VBA

[indiewolf]

For k = 0 To 675
    For l = 0 To 25
        For m = 0 To 25
            For n = 0 To 25
                For o = 0 To 9
                    For p = 0 To 25
                             
                         Code = VType(k, 0) & Sched(l, 0) & Spec(m, 0) & Ends(n, 0) & FR(o, 0) & Mat(p, 0)
                         count = WorksheetFunction.CountIf(Range("Sheet1!$F7:$F" & LastRow), Code)
                          
                        If count > 0 Then
                          i = i + 1
                          ws.Cells(i, 1).Value = Code
                           ws.Cells(i, 26).Value = count
                       End If
                       Next
                    Next
                Next
            Next
        Next
    Next

i know the above loop works and will give me the right output but it is very very slow and is taking more than 30 minutes to complete.
how can i speed it up?
please help

cheers

[si_the_geek]

Please always post code inside Code or VBCode tags.

You are running the inner part of the code (which includes a call to a function that isn't exactly instantaneous) a total of 676*26*26*26*10*26 = 3,089,157,760 times, so it isn't surprising that it takes a while to finish!

There are ways to speed up your current code, but not by the kind of dramatic amounts to make it usable - it would be better to re-think what you are doing, and use a different method instead.


What kind of methods you could use depend on various things, such as:

• what kind of values will the Code variable contain?
• for the things like VType(k, 0) , is there any repetition? (eg: can VType(1, 0) be the same as say VType(424, 0) ? )
• what are VType/Sched/etc ?
• how many rows of data are there?
• do all of the cells in that range have values that could be equal to Code?
• does the order of the output matter?

[indiewolf]

sorry about the tags.

1)the code variable will contain BF1GF1C, BFAFC1A type variables.
2,3) no repetition , becoz vtype etc have either 0 to 9 numbers or A-Z alphabets
4)the rows of data is quite large
5)yes all cells in that range WILL have the same values just random ones like the example given above.
6)what do you mean by the order of the output? if u mean that the numeric part is in 3rd and 6th position then yes for some types and then numeric part in 6th position for some types whereas all positions are alphabets. so two types in all but varying from a-Z and 0-9.

i hope that helps.
please help me, i am in a soup!

cheers

[si_the_geek]

a) I presume that VType is two characters - is that correct?

b) What actually are VType etc, are they functions? arrays? (if they are arrays, are they sorted?)

c) you say "the rows of data is quite large", but does that mean 'about 500 to 1000 rows'? 'about 10000 to 15000'? 'about 400 billion'?

d) By order of the output, I meant for the things you are outputting (eg: ws.Cells(i, 1).Value = Code ) do you mind what order those rows are shown in? (eg: does it matter if BF1GF1C is before or after BFAFC1A?)

[si_the_geek]

Oh, and another one:

e) are all of the cell values valid codes, or could there be some that aren't apt? (eg: could there be one that contains $£%"&(" , or values that aren't in VType etc?)

[indiewolf]

1) yes it is charact, it is made up of two alphabets --vtype =AA,BA etc

2)yes they are functions
for eg:

a = 0
                        For b = 65 To 90
                        For c = 65 To 90
                          VType(a, 0) = Chr(b) & Chr(c)
                          a = a + 1
                        Next
                        Next
                        
                         a = 0
                         For d = 65 To 90
                           Sched(a, 0) = Chr(d)
                           a = a + 1
                         Next

3)it is random , at present i have 6578 rows ie 6578 CODE variables, in a column. it can increase decrease as per sheets.
4)no it doesn't matter, but with the loop i had everything in order already.
5)no they are always, all valid codes. some cells may be blank but that can be easily skipped, hence they are all valid codes.

[si_the_geek]

2)yes they are functions

No they aren't, those are arrays.

5) no they are always, all valid codes. some cells may be blank but that can be easily skipped, hence they are all valid codes.

In that case, all you need to do is create a count of each non-blank value.... so why bother with doing things like creating the Code variable, etc?


To do it you just need to loop thru each row of data once, and compare it to the ones you have already read (if found increment the counter, else add it).

For 6578 rows that will mean a maximum (if the count is only ever 1) of about 2 million quick operations, rather than 3 billion very slow ones... so it should be thousands of times faster (or more).

If you could be certain that the codes were in order (so if there are multiple rows with BF1GF1C in, they are immediately after each other) it could be made faster still, but I think this will be a big enough improvement (and safe).

I was bored, so decided to write it out... but note that I haven't tested it:

Dim strCodes() As String      'the array containing Codes and count
Dim lngCodesMax As Long       'how many codes have we stored so far?  (avoids Redim Preserve which is slow)
Dim lngRowNum As Long         'the row that is being read from
Dim strCell As String         'the text of the cell
Dim lngCodesCheck As Long     'the array item it is being compared it to
Dim booFound As Boolean       'was it found in the array?

      'Set up the array to be able to store all the rows
  ReDim strCodes(LastRow - 7, 1) As String
  lngCodesMax = -1

      'For each row of data...
  For lngRowNum = 7 To LastRow
        '..if not blank
    strCell = UCase(Trim(sheet1.cells(lngRowNum, 6)))
    If strCell <> "" Then
          '..see if it is in the array
      booFound = False
      lngCodesCheck
      For lngCodesCheck = 0 To lngCodesMax
        If strCodes(lngCodesCheck, 0) = strCell Then
          booFound = True
              '..if it is, increment the count (and stop checking it against the other codes)
          strCodes(lngCodesCheck, 0) = Val(strCodes(lngCodesCheck, 1)) + 1
          Exit For
        End If
      Next lngCodesCheck      
             '..if not in the array, add it with a count of 1
      If Not booFound Then
        lngCodesMax = lngCodesMax + 1
        strCodes(lngCodesMax, 0) = strCell
        strCodes(lngCodesMax, 1) = 1
      End If
    End If
  Next lngRowNum  
  
    'Output the results (assumes i is set as it was for the old loops)
  For lngRowNum = 0 To lngCodesMax
    ws.cells(i + lngRowNum + 1, 1).Value = strCodes(lngRowNum, 0)
    ws.cells(i + lngRowNum + 1, 26).Value = strCodes(lngRowNum, 1)
  Next lngRowNum
  
    'tidy up
  Erase strCodes

If you want, you can even do a check that each code is valid (and it will be quick), just show me all of the code you use to declare and set up VType etc.