[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 271
  • Last Modified:

How do I extend the rows limit with this macro?

Hi,

This is a follow-up question for a Macro/Workbook that Andrewssd3 kindly designed for me. However, when more data is inputted to the workbook, I get the "run-time error'1004'".

I believe this is because there aren't enough rows in sheet "Result". However, with my limited knowledge with Excel, I do not know how to get around it. All I know is that maybe the result could be dumped back on multiple sheets to solve the Rows limit problem? Or maybe the result could be dumped on a completely separate workbook and saved as a separate workbook and just close the result workbook and create another one automatically (because the file size for the result would be very large due to the large amount of data)?

If Andrewssd3 or any other experts can help, that would be great.

((By the way, the operating system is Windows 7 64bit with Excel 2010 64bit.
Earlier, when I ran on Windows 7 32bit with Excel 32bit, it actually gave me out of memory problem before it even runs))

Thanks you very much.
Run-time-error--1004-.jpg
Survey--Extended.xlsm
0
WiilingToPaypalAGoodCoder
Asked:
WiilingToPaypalAGoodCoder
1 Solution
 
ragnarok89Commented:
If you are using excel 2003, you have a max row limit of 65,536. Excel 2010 has increased this limit to over a million.

If you have to stay on Excel 2003, add a counter.
Count = 1
    For r = 1 To lngNumMakes
        If Count < 65535 Then
            rngResult.Offset(0, r - 1).Value = aMakes(r, 1)
            Count = Count + 1
        Else
            Sheets.Add
            Count = 1
        End If
    Next r

Open in new window


this way, every time you get to the 65535th line, you create a new worksheet and keep going.
0
 
WiilingToPaypalAGoodCoderAuthor Commented:
hi ragnarok89,

Thanks for the reply.
But unfortunately, I am already running excel 2010 64bit already.
When I run the macro, when it output the result to my "Result" sheet, due to the large amount of data, it still exceed the 1 million limit that it has.

I am thinking that the only way for it to work is to perhaps output the data on a separate sheets so there's another million(s) of rows to output the data.

However, I am not knowledgeable enough to do that with the macro. That's why I am seeking for help on this matter.

Thanks
0
 
Arno KosterCommented:
pay attention to the fact that declaring the aResults integer array with dimensions 3.199.999x49, excel will require 156.799.951 time the amount of memory needed for a single integer. An integer array with dimension 1.000 will take about 2kB of memory, thus in total you would need 308MB of memory.
This in itself should certainly be possible, but apperantly Excel 2007 will go no further than dim array_of_integers(134.152.175) on 32 bit machines.

As the excel 2010 worksheet is constrained by both a maximum of 1.048.576 rows and a 2GB memory capacity, you would either need 4 worksheets to contain all numbers or you should switch to access which will be able to handle such amounts of data.

you could try using something like

dim aResults1(1000000)
dim aResults2(1000000)
dim aResults3(1000000)
dim aResults4(1000000)

for pos = 0 to ubound(aResults)
if pos < 1000000 then aResults1(pos) = aResults(pos)
elseif pos < 2000000 then aResults2(pos-1000000) = aResults(pos)
elseif pos < 3000000 then aResults2(pos-2000000) = aResults(pos)
else aResults2(pos-3000000) = aResults(pos)
end if
next pos

Set rngResult = ThisWorkbook.Worksheets("Result1").Cells(1)
Set rngResult = rngResult.Offset(1, 0).Resize(1000001, lngResultCols + 1)
rngResult.Value = aResults1

Set rngResult = ThisWorkbook.Worksheets("Result2").Cells(1)
Set rngResult = rngResult.Offset(1, 0).Resize(1000001, lngResultCols + 1)
rngResult.Value = aResults2

Set rngResult = ThisWorkbook.Worksheets("Result3").Cells(1)
Set rngResult = rngResult.Offset(1, 0).Resize(1000001, lngResultCols + 1)
rngResult.Value = aResults3

Set rngResult = ThisWorkbook.Worksheets("Result4").Cells(1)
Set rngResult = rngResult.Offset(1, 0).Resize(lngResultRows + 1 - 3000000, lngResultCols + 1)
rngResult.Value = aResults4

Open in new window

0
Restore individual SQL databases with ease

Veeam Explorer for Microsoft SQL Server delivers an easy-to-use, wizard-driven interface for restoring your databases from a backup. No expert SQL background required. Web interface provides a complete view of all available SQL databases to simplify the recovery of lost database

 
WiilingToPaypalAGoodCoderAuthor Commented:
Hi akoster,

Thanks for the reply.
I apologize for the stupid question, but do I copy/paste the code you provided and combine it with the one AndrewSSD3 helped me create? or I run the code you provide separately?

Thank you very much
0
 
kgerbChief EngineerCommented:
Try this workbook on your machine.  I keep getting out of memory errors on mine but I'm running 2007 32 bit.  Not sure if it will make a difference on your machine.

I modified the code to add additional worksheets as necessary.

Kyle
Q-27411797-RevA.xlsm
0
 
WiilingToPaypalAGoodCoderAuthor Commented:
Hi Kgerb,

Thanks for the reply.

I just ran the workbook that you uploaded. It works 50%, kind of.
It actually seemed to successfully create 4 result worksheets (which is about right, given 20^5 = 3200000, and 1 million per sheet, so it's about right.)

However, the problem is, there's no actual result (data) at all in the worksheets (other than the title<carmakes> in the first row)

Could you help me look into it?

Thanks for the help and the effort.


0
 
kgerbChief EngineerCommented:
Lol, oops, my bad.  I forgot to uncomment the only line in the actual sub that does anything:)

Change this...
            'rngResult.Value = arrTemp

Open in new window

to this...
            rngResult.Value = arrTemp

Open in new window

Now try it

Kyle
0
 
kgerbChief EngineerCommented:
Also, you'll need to delete the four sheets created by running the sub the first time.  Otherwise you'll get an error for trying to name two sheets the same name.

kyle
0
 
WiilingToPaypalAGoodCoderAuthor Commented:
Hi Kyle,

Once again, thanks a lot for helping out.
It is closer to getting perfect, as it DOES output the data/result to the Reesult Sheets .

However, I realized that, for the carmake, "Volvo" on the result sheets (the 50th column, the last carmake), it DOES NOT have any data at all. Another word, that column is all empty.

so it seems like the output data is off.

Otherwise, it seems to be working fine.

Another thing is though, do you think it is possible to output the results to a separate workbook?
What i mean is, the "survey data" provides the data, and then generate the results, output on a separate workbook's Result1. When that Result 1 reaches the million row, it autosaves as "date - Result1", and then open another workbook.Result2, and then once it reaches its max, autosaves, and then close, and then create a newworkbook, Result3...etc and so on?

The reason for that is because, when I ran the macro just now, my windows memory almost maxed out because of over 3 millions of data. But just now, right after I deleted the result sheets, I got my memory back right away. Therefore, I am wondering if it's possible to run like that so it doesn't max out my windows memory??

Thank you very much and i truly appreciate your help.

0
 
kgerbChief EngineerCommented:
I will fix the problem with the columns being off by one.  Shouldn't be too hard.  I will also adjust the code to add the sheets to a new workbook.  Give me about an hour though.  I have a meeting that I need to attend.  I'll do it after that.  Thanks.

Kyle
0
 
WiilingToPaypalAGoodCoderAuthor Commented:
Hi Kyle,

Thank you very very much for your help. I truly appreciate it.

Please take your time, no pressure.

0
 
WiilingToPaypalAGoodCoderAuthor Commented:
Hi Kyle,

Sorry to bother you when you're busy.
I was just wondering the code that you implemented for adding extra sheets as needed, were they also implemented to "RunAnalysisV2()'?

I was running the RunAnalysisV2() just now, it seems like it still ran out of sheet as well. If it's not too troublesome, could you help me implement the code for RunAnalysisV2()? They are essentially the same thing, it's just they output data a little differently. But the amount of rows and the data to calculate are the same.

Thanks a lot and please take your time as I understand you're busy and this is definitely taking up your time.

Thank you very much
0
 
kgerbChief EngineerCommented:
Ok,
I think this will work now.  Interestingly, I was able to get it to run from start to finish using the "RunAnalysis" sub.  Then when I copied the code to the "RunAnalysisV2" I keep getting out of memory errors.  Take a look and see if it works for you.

Note:  you will need to change this line according to wherever you want the files saved
.SaveAs "C:\Kyle\Result" & i

Open in new window


Kyle
Public Sub RunAnalysisV2()
    Dim lngRowsPerSheet As Long
    Dim lngColsPerSheet As Long
    Dim lngNumSheets As Long
    Dim lngNumMakes As Long
    Dim strLookupTableStart As String
    Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long, i5 As Long
    Dim r As Long
    Dim rngResult As Excel.Range
    
    Dim lngResultIX As Long
    
    Dim lngResultRows As Long, lngResultCols As Long
    
    Dim aResults() As Integer
    Dim aMakes As Variant           ' the list of all makes
    
    Dim aTable1 As Variant, aTable2 As Variant, aTable3 As Variant
    Dim aTable4 As Variant, aTable5 As Variant
    Dim i As Long, j As Long, k As Long, gap As Long, UBnd1 As Long, UBnd2 As Long, sht As Worksheet, frow As Long
    
Sheets("Speed Evaluation").Select
Range("A1").FormulaR1C1 = "=NOW()"
Range("A1").Value = Range("A1").Value

    
    lngNumSheets = 5
    strLookupTableStart = "A100"
    
    With ThisWorkbook.Worksheets
        aTable1 = .Item("Sheet1").Range(strLookupTableStart).CurrentRegion.Value
        aTable2 = .Item("Sheet2").Range(strLookupTableStart).CurrentRegion.Value
        aTable3 = .Item("Sheet3").Range(strLookupTableStart).CurrentRegion.Value
        aTable4 = .Item("Sheet4").Range(strLookupTableStart).CurrentRegion.Value
        aTable5 = .Item("Sheet5").Range(strLookupTableStart).CurrentRegion.Value
        aMakes = .Item("Working area").Range("CarMakes").Value
    End With
    
    ' get the number of rows and cols (assume all tables are same dimensions)
    lngRowsPerSheet = UBound(aTable1, 1)
    lngColsPerSheet = UBound(aTable1, 2)
    ' get the count of makes from the list on the working tab
    lngNumMakes = UBound(aMakes, 1)
    
    lngResultRows = lngColsPerSheet ^ lngNumSheets - 1
    lngResultCols = lngNumMakes - 1
    
    ' set up the results table
    ' there is one column per make in the result table, numbered sequentially from 0
    ' as in the list on the Working area tab
    ReDim aResults(lngResultRows, lngResultCols)
    
    lngResultIX = 0
    For i1 = 1 To lngColsPerSheet
        For i2 = 1 To lngColsPerSheet
            For i3 = 1 To lngColsPerSheet
                For i4 = 1 To lngColsPerSheet
                    For i5 = 1 To lngColsPerSheet
                        For r = 1 To lngRowsPerSheet
                            aResults(lngResultIX, aTable1(r, i1)) = aResults(lngResultIX, aTable1(r, i1)) + 1
                        Next r
                        For r = 1 To lngRowsPerSheet
                            aResults(lngResultIX, aTable2(r, i2)) = aResults(lngResultIX, aTable2(r, i2)) + 1
                        Next r
                        For r = 1 To lngRowsPerSheet
                            aResults(lngResultIX, aTable3(r, i3)) = aResults(lngResultIX, aTable3(r, i3)) + 1
                        Next r
                        For r = 1 To lngRowsPerSheet
                            aResults(lngResultIX, aTable4(r, i4)) = aResults(lngResultIX, aTable4(r, i4)) + 1
                        Next r
                        For r = 1 To lngRowsPerSheet
                            aResults(lngResultIX, aTable5(r, i5)) = aResults(lngResultIX, aTable5(r, i5)) + 1
                        Next r
                        lngResultIX = lngResultIX + 1
                    Next i5
                Next i4
            Next i3
        Next i2
    Next i1
    
    'dump values back to worksheets
    frow = 2
    gap = 2 ^ 20 - frow
    If frow + lngResultRows > 2 ^ 20 Then
        For i = 1 To Int(lngResultRows / gap) + 1
            UBnd1 = IIf(gap * (i) > lngResultRows, lngResultRows - (gap * (i - 1)), gap)
            UBnd2 = UBound(aResults, 2)
            ReDim arrTemp(UBnd1, UBnd2)
            For j = LBound(arrTemp, 2) To UBound(arrTemp, 2)
                For k = LBound(arrTemp, 1) To UBound(arrTemp, 1)
                    arrTemp(k, j) = aResults(k + gap * (i - 1), j)
                Next k
            Next j
            'Make new workbook
            With Workbooks.Add
                Set sht = .Sheets(1)
                sht.Name = "Result" & i
                'car values
                Set rngResult = sht.Cells(1)
                For r = 1 To lngNumMakes
                    rngResult.Offset(0, r - 1).Value = aMakes(r, 1)
                Next r
                'integer values
                Set rngResult = sht.Cells(frow, 1).Resize(UBound(arrTemp, 1) + 1, UBound(arrTemp, 2) + 1)
                rngResult.Value = arrTemp
                'Save and close
                .SaveAs "C:\Kyle\Result" & i
                .Close
            End With
        Next i
    End If
    
Sheets("Speed Evaluation").Select
Range("A2").FormulaR1C1 = "=NOW()"
Range("A2").Value = Range("A2").Value
    
End Sub

Open in new window

0
 
WiilingToPaypalAGoodCoderAuthor Commented:
Hi Kyle,

Thanks for the update (and sorry for the late reply)
I ran the macro again.
However, it doesn't seem to be generating the right result.

However, it is my fault though as I never really clearly explained what the macro was supposed to be doing/the type of result it is generating.

Basically, what the macro does is that is tests all different types combination and output the result in the result sheet. For example,
===============================================================
For VBA Ver1:

1st Combination:
1) Out of all 270 names from
Sheet1 - Column A (54 names from A2~A55)
Sheet2 - Column A (54 names from A2~A55)
Sheet3 - Column A (54 names from A2~A55)
Sheet4 - Column A (54 names from A2~A55)
Sheet5 - Column A (54 names from A2~A55)

count the appearance of each carmake and output them in Result Sheet.

and then move on to 2nd Combination:
Sheet1 - Column A (54 names from A2~A55)
Sheet2 - Column A (54 names from A2~A55)
Sheet3 - Column A (54 names from A2~A55)
Sheet4 - Column A (54 names from A2~A55)
Sheet5 - Column B (54 names from B2~B55)

count the appearance of each carmake and output them in Result sheet..

and so on.....

until last Combination

Sheet1 - Column T (54 names from T2~T55)
Sheet2 - Column T (54 names from T2~T55)
Sheet3 - Column T (54 names from T2~T55)
Sheet4 - Column T (54 names from T2~T55)
Sheet5 - Column T (54 names from T2~T55)


count the appearance of each carmake and output them in Result sheet..



==========================================================

For Ver.2, it is still the same, except the output condition/format is a little bit different. But the combination and everything is the same still. For example:

1st Combination:
1) Out of all 270 names from
Sheet1 - Column A (54 names from A2~A55)
Sheet2 - Column A (54 names from A2~A55)
Sheet3 - Column A (54 names from A2~A55)
Sheet4 - Column A (54 names from A2~A55)
Sheet5 - Column A (54 names from A2~A55)

ONLY OUTPUT carmakes that DO NOT show up in the combination. and then move on to 2nd Combination,

Sheet1 - Column A (54 names from A2~A55)
Sheet2 - Column A (54 names from A2~A55)
Sheet3 - Column A (54 names from A2~A55)
Sheet4 - Column A (54 names from A2~A55)
Sheet5 - Column B (54 names from B2~B55)

again, ONLY OUTPUT carmakes that DO NOT show up in the combination. and then move on to 3rd Combination,

it goes on until the last combination.

Sheet1 - Column T (54 names from T2~T55)
Sheet2 - Column T (54 names from T2~T55)
Sheet3 - Column T (54 names from T2~T55)
Sheet4 - Column T (54 names from T2~T55)
Sheet5 - Column T (54 names from T2~T55)

and then output ONLY carmakes that do not show up for the specific combination.
===================================================================

Your macro works pretty nicely in terms of outputing the results in separatework, and then save & close.
It's just, unfortunately, the data doesn't seem to be accurate,

For example, in the result generated by the macro, for the first combination, it shows there are only 8 aston martins. However, when I manually copied all the column 1 together and did a countif, it seems like Aston Martn should appear 10 times for the first combination.

To better illustrate, this post is attached with the workbook/macro AndrewSSD3 help create. It works well with the exception of memory problem.

Maybe you can give the macro a quick run, so you will have a better idea what I mean.

Once again, thank you very much and I apologize for being so troublesome ^^"
Car-Survey--original-.xlsm
0
 
kgerbChief EngineerCommented:
Hello William,
I do not believe there is any difference between the two versions of the subroutine.  The code is EXACTLY the same.  The only reason mine wasn’t working yesterday with V2 was b/c I forgot to copy over a dimension statement from V1.  Thanks for the explanation though.  AndrewSSD3 came up with a very interesting way of counting the occurrences of the care makes for every combination.

I can’t find a problem with how the program is working.  I have done several manual comparisons and each one comes back exactly the same as the program results.  There are only 8 instances of “Aston Marton” in the first combination.  See the attached worksheet for my comparison results.  The only difference is on row 14 and it’s b/c you listed “Dodge” twice in your list of “makes”.

Anyway, as far as I can tell it’s working properly.  I ran it from start to finish and without error.  It took a while but it finished.  You might want to think about a progress indicator for this routine since it takes so long to run.  Google “Excel VBA progress indicator” and you’ll get lots of results.  If you need help implementing any of them let us know.  Me or anyone else will be glad to help.

The attached code is a revised edition of V2.  It I took out an unnecessary IF statement and I added the required array declaration to keep from getting the error I had yesterday.

Kyle

Public Sub RunAnalysisV2()
Dim lngRowsPerSheet As Long
Dim lngColsPerSheet As Long
Dim lngNumSheets As Long
Dim lngNumMakes As Long
Dim strLookupTableStart As String
Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long, i5 As Long
Dim r As Long
Dim rngResult As Excel.Range

Dim lngResultIX As Long

Dim lngResultRows As Long, lngResultCols As Long

Dim aResults() As Integer
Dim aMakes As Variant           'the list of all makes

Dim aTable1 As Variant, aTable2 As Variant, aTable3 As Variant
Dim aTable4 As Variant, aTable5 As Variant
Dim i As Long, j As Long, k As Long, gap As Long, UBnd1 As Long, UBnd2 As Long, sht As Worksheet, frow As Long
Dim arrTemp() As Single
    
Sheets("Speed Evaluation").Select
Range("A1").FormulaR1C1 = "=NOW()"
Range("A1").Value = Range("A1").Value

    
lngNumSheets = 5
strLookupTableStart = "A100"

With ThisWorkbook.Worksheets
    aTable1 = .Item("Sheet1").Range(strLookupTableStart).CurrentRegion.Value
    aTable2 = .Item("Sheet2").Range(strLookupTableStart).CurrentRegion.Value
    aTable3 = .Item("Sheet3").Range(strLookupTableStart).CurrentRegion.Value
    aTable4 = .Item("Sheet4").Range(strLookupTableStart).CurrentRegion.Value
    aTable5 = .Item("Sheet5").Range(strLookupTableStart).CurrentRegion.Value
    aMakes = .Item("Working area").Range("CarMakes").Value
End With

' get the number of rows and cols (assume all tables are same dimensions)
lngRowsPerSheet = UBound(aTable1, 1)
lngColsPerSheet = UBound(aTable1, 2)
' get the count of makes from the list on the working tab
lngNumMakes = UBound(aMakes, 1)

lngResultRows = lngColsPerSheet ^ lngNumSheets - 1
lngResultCols = lngNumMakes - 1

' set up the results table
' there is one column per make in the result table, numbered sequentially from 0
' as in the list on the Working area tab
ReDim aResults(lngResultRows, lngResultCols)

lngResultIX = 0
For i1 = 1 To lngColsPerSheet
    For i2 = 1 To lngColsPerSheet
        For i3 = 1 To lngColsPerSheet
            For i4 = 1 To lngColsPerSheet
                For i5 = 1 To lngColsPerSheet
                    For r = 1 To lngRowsPerSheet
                        aResults(lngResultIX, aTable1(r, i1)) = aResults(lngResultIX, aTable1(r, i1)) + 1
                    Next r
                    For r = 1 To lngRowsPerSheet
                        aResults(lngResultIX, aTable2(r, i2)) = aResults(lngResultIX, aTable2(r, i2)) + 1
                    Next r
                    For r = 1 To lngRowsPerSheet
                        aResults(lngResultIX, aTable3(r, i3)) = aResults(lngResultIX, aTable3(r, i3)) + 1
                    Next r
                    For r = 1 To lngRowsPerSheet
                        aResults(lngResultIX, aTable4(r, i4)) = aResults(lngResultIX, aTable4(r, i4)) + 1
                    Next r
                    For r = 1 To lngRowsPerSheet
                        aResults(lngResultIX, aTable5(r, i5)) = aResults(lngResultIX, aTable5(r, i5)) + 1
                    Next r
                    lngResultIX = lngResultIX + 1
                Next i5
            Next i4
        Next i3
    Next i2
Next i1

'dump values back to worksheets
frow = 2
gap = 2 ^ 20 - frow
For i = 1 To Int(lngResultRows / gap) + 1
    UBnd1 = IIf(gap * (i) > lngResultRows, lngResultRows - (gap * (i - 1)), gap)
    UBnd2 = UBound(aResults, 2)
    ReDim arrTemp(UBnd1, UBnd2)
    For j = LBound(arrTemp, 2) To UBound(arrTemp, 2)
        For k = LBound(arrTemp, 1) To UBound(arrTemp, 1)
            arrTemp(k, j) = aResults(k + gap * (i - 1), j)
        Next k
    Next j
    'Make new workbook
    With Workbooks.Add
        Set sht = .Sheets(1)
        sht.Name = "Result" & i
        'car values
        Set rngResult = sht.Cells(1)
        For r = 1 To lngNumMakes
            rngResult.Offset(0, r - 1).Value = aMakes(r, 1)
        Next r
        'integer values
        Set rngResult = sht.Cells(frow, 1).Resize(UBound(arrTemp, 1) + 1, UBound(arrTemp, 2) + 1)
        rngResult.Value = arrTemp
        'Save and close
        Application.DisplayAlerts = False
        .SaveAs "C:\Kyle\Result" & i
        .Close
        Application.DisplayAlerts = True
    End With
Next i

Sheets("Speed Evaluation").Select
Range("A2").FormulaR1C1 = "=NOW()"
Range("A2").Value = Range("A2").Value
End Sub

Open in new window

Q-27411797-RevC.xlsx
0
 
kgerbChief EngineerCommented:
oops, sorry, you're name is not William.  Had that carried over from an e-mail.  sorry.

Kyle
0
 
WiilingToPaypalAGoodCoderAuthor Commented:
Hi Kyle,

Thank you VERY MUCH for the update. I ran it several times today as well and it runs perfectly fine. Thank you very much.

One last thing before I close the thread (as you pretty much solved the my problem already):
For the original file from AndrewSSD3, Version 1 & Version 2 are different in terms of how they write the result back, here are the codes from the workbook attached:
<<this original one has smaller data set, only takes 30 seconds ~ 1 minute to run both versions of the macro>>

Version 1
'VERSION 1:
    ' dump the values back into the results sheet
    Set rngResult = ThisWorkbook.Worksheets("Result").Cells(1)

    For r = 1 To lngNumMakes
        rngResult.Offset(0, r - 1).Value = aMakes(r, 1)
    Next r
    
    Set rngResult = rngResult.Offset(1, 0).Resize(lngResultRows + 1, lngResultCols + 1)
    rngResult.Value = aResults

Open in new window

Version 1 outputs the same type of result format <occurance count for each carmake shown in a table > you have written the code for me (thanks again)

Whereas version Version 2
'VERSION 2:

    ' dump the values back into the results sheet
    Set rngResult = ThisWorkbook.Worksheets("Result").Cells(1)
    
    For r = 0 To lngResultRows
        For i1 = LBound(aResults, 2) To UBound(aResults, 2)
            If aResults(r, i1) = 0 Then
                rngResult.Value = aMakes(i1 + 1, 1)
                Set rngResult = rngResult.Offset(0, 1)
            End If
        Next i1

        Set rngResult = rngResult.Offset(1, 1 - rngResult.Column)
    Next r

Open in new window

This one ONLY outputs the CARMAKES with ZERO OCCURANCE in the result sheet.
So for instance,
(1st combination)Row1 only has 7 carmakes
(2nd combination) Row2 only has 7 carmakes
(3rd combination) Row 3 only has 8 carmakes... and so on
(You can give it a run with the attached file and you will know what I mean)

I may be asking you too much for it, so it is okay if it is NOT do-able, but if possible, could you maybe make some modification so it only outputs the carmakes with zero occurance (instead of every carmake with their occurance ) and save it as V3,

The reason for that is because I realize EACH result workbook saved it QUITE HUGE (over 200MB). Actually, AndrewSSD3 has warned me before that this would take longer time to run (with my little knowledge of VBA, my guess is because there's more code?) However, given that there should be less data, meaning smaller file size, I think it might be more practical.

Hence, if possible, it would be nice to have the result with only CARMAKE with 0 occurance so the file size of the result workbook would be a lot smaller.

But if it is too troublesome this time, it is okay too as I will just wait for next time.

Thank you very much (and thank you for the tips on the progress indicator, I will definitely look it up)
You have been truly amazing =)
0
 
kgerbChief EngineerCommented:
Ok, let's try this.  Hopefully you will like the way this works.  Instead of dumping the whole array to the worksheets I am reporting just the instances where a car make does not exist for a combination.  This way you don’t have to add multiple sheets.  All the results will fit on one sheet.  For the current data set there are a little over 500,000 combinations where a model does not exist.  It took me about 9 minutes to run.  You can copy and paste this code into your workbook and it should work.  You will, however, need a sheet named “Results” for the data to be stored.
Public Sub RunAnalysisV3()
Dim lngRowsPerSheet As Long
Dim lngColsPerSheet As Long
Dim lngNumSheets As Long
Dim lngNumMakes As Long
Dim strLookupTableStart As String
Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long, i5 As Long
Dim r As Long
Dim rngResult As Excel.Range

Dim lngResultIX As Long

Dim lngResultRows As Long, lngResultCols As Long

Dim aResults() As Integer
Dim aMakes As Variant           'the list of all makes

Dim aTable1 As Variant, aTable2 As Variant, aTable3 As Variant
Dim aTable4 As Variant, aTable5 As Variant
Dim i As Long, j As Long, k As Long, gap As Long, UBnd1 As Long, UBnd2 As Long, sht As Worksheet, frow As Long
Dim arrTemp() As String, arrTemp2() As String
Dim OneExists As Boolean
    
With Sheets("Speed Evaluation")
    .Range("A1").FormulaR1C1 = "=NOW()"
    .Range("A1").Value = .Range("A1").Value
End With
    
lngNumSheets = 5
strLookupTableStart = "A100"

With ThisWorkbook.Worksheets
    aTable1 = .Item("Sheet1").Range(strLookupTableStart).CurrentRegion.Value
    aTable2 = .Item("Sheet2").Range(strLookupTableStart).CurrentRegion.Value
    aTable3 = .Item("Sheet3").Range(strLookupTableStart).CurrentRegion.Value
    aTable4 = .Item("Sheet4").Range(strLookupTableStart).CurrentRegion.Value
    aTable5 = .Item("Sheet5").Range(strLookupTableStart).CurrentRegion.Value
    aMakes = .Item("Working area").Range("CarMakes").Value
End With

' get the number of rows and cols (assume all tables are same dimensions)
lngRowsPerSheet = UBound(aTable1, 1)
lngColsPerSheet = UBound(aTable1, 2)
' get the count of makes from the list on the working tab
lngNumMakes = UBound(aMakes, 1)

lngResultRows = lngColsPerSheet ^ lngNumSheets - 1
lngResultCols = lngNumMakes - 1

' set up the results table
' there is one column per make in the result table, numbered sequentially from 0
' as in the list on the Working area tab
ReDim aResults(lngResultRows, lngResultCols)
ReDim arrTemp2(lngResultRows)

lngResultIX = 0
For i1 = 1 To lngColsPerSheet
    For i2 = 1 To lngColsPerSheet
        For i3 = 1 To lngColsPerSheet
            For i4 = 1 To lngColsPerSheet
                For i5 = 1 To lngColsPerSheet
                    arrTemp2(lngResultIX) = i1 & "-" & i2 & "-" & i3 & "-" & i4 & "-" & i5
                    For r = 1 To lngRowsPerSheet
                        aResults(lngResultIX, aTable1(r, i1)) = aResults(lngResultIX, aTable1(r, i1)) + 1
                    Next r
                    For r = 1 To lngRowsPerSheet
                        aResults(lngResultIX, aTable2(r, i2)) = aResults(lngResultIX, aTable2(r, i2)) + 1
                    Next r
                    For r = 1 To lngRowsPerSheet
                        aResults(lngResultIX, aTable3(r, i3)) = aResults(lngResultIX, aTable3(r, i3)) + 1
                    Next r
                    For r = 1 To lngRowsPerSheet
                        aResults(lngResultIX, aTable4(r, i4)) = aResults(lngResultIX, aTable4(r, i4)) + 1
                    Next r
                    For r = 1 To lngRowsPerSheet
                        aResults(lngResultIX, aTable5(r, i5)) = aResults(lngResultIX, aTable5(r, i5)) + 1
                    Next r
                    For r = 0 To lngResultCols
                        If aResults(lngResultIX, r) <> 0 Then aResults(lngResultIX, r) = Empty Else aResults(lngResultIX, r) = 1
                    Next r
                    lngResultIX = lngResultIX + 1
                Next i5
            Next i4
        Next i3
    Next i2
Next i1

With Sheets("Results")
    Set rngResult = .Cells(1, 1)
    For j = LBound(aResults, 1) To UBound(aResults, 1)
        For i = LBound(aResults, 2) To UBound(aResults, 2)
            If aResults(j, i) = 1 Then
                OneExists = True
                Exit For
            End If
        Next i
        If OneExists Then
            rngResult = arrTemp2(j)
            For k = LBound(aResults, 2) To UBound(aResults, 2)
                If aResults(j, k) = 1 Then .Cells(rngResult.Row, Columns.Count).End(xlToLeft).Offset(, 1) = aMakes(k + 1, 1)
            Next k
            Set rngResult = rngResult.Offset(1)
            OneExists = False
        End If
    Next j
End With

With Sheets("Speed Evaluation")
    .Range("A2").FormulaR1C1 = "=NOW()"
    .Range("A2").Value = .Range("A2").Value
    .Activate
End With
End Sub

Open in new window

Q-27411797-RevD.xlsm
0
 
WiilingToPaypalAGoodCoderAuthor Commented:
Thank you very much, Kyle, you have been extremely help =)
The last one that you posted seemed very efficient.

Just want to double-check, IF the data set gets bigger, when it exceeds the "Result" sheet, will the extra sheets still be automatically created/saved separately?

You have been awesome! Thank you very much =)
0
 
kgerbChief EngineerCommented:
You're welcome.  Glad I could help.

To answer your question, no, sorry.  I thought about that but I didn't have time to implement it.  If you think you'll need that capability ask another question and I (or someone else) will be happy to assist you.

One more thought, you are pushing the limits of excel right now.  When dealing with this much data it gets slow and buggy.  We were able to kind of dance around the edges this time but in general these kinds of problems are best handled in Access.  It is designed to handle incredibly large tables with millions of rows.  A query in access would return your desired data in seconds, not minutes.  

If you absolutely have to do it in Excel (for whatever reason) you could also create an ADODB recordset, query the recordest for your desired result, and then dump the results back onto a worksheet.  I think it would be faster than what you have right now as well.

Good luck!

Kyle
0
 
WiilingToPaypalAGoodCoderAuthor Commented:
Thank you Kyle for all your help.

I just posted a followup question (  http://www.experts-exchange.com/Microsoft/Development/MS_Access/Q_27419603.html  )regarding the recommendation made by you & Akoster regarding switching to Access for processing such large amount of data. (i didn`t have to stick with excel, i just know it better than excel. As a matter of fact, i know nothing about Access =(   )

Thanks again =)

If you
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now