asked on

Efficient/Fast VBA Macro Help

Hi experts,

Thanks for taking the time to read and help.

I NEED HELP with AUTOMATING the repetitive tasks into a Macro file.
I managed to do it with FOR/LOOP & copy/paste/countif/screenupdating(off)/ through Macro Recorder + a little bit of modification)
However, it seems to be EXTREMELY UNEFFICIENT & VERY SLOW with the macro recorder.

Since time is money, I have joined EE to seek for your professional help to create an as EFFICIENT WAY/FASTEST WAY as possible to complete the task.
(If necessary, the data/design/layout of the workbook can be changed if efficiency/speed can be gained.)
I would even paypal $50 for the most efficient/fastest code.

I have 5 Groups of Data (Currently, they are stored in 5 different Sheets - Sheet1, Sheet2, Sheet3, Sheet4, Sheet5).
<<Worksheet can be viewed here>>
https://docs.google.com/spreadsheet/ccc?key=0Armd7a_SIR60dDRhSlRzU0ZmWTJKVlVmRzByQ2hJX2c&hl=en_GB

EACH group in each sheet contains 10 ROWS & 14 COLUMNs.
- 1st Row = Label (1, 2, 3,.....14th Column)
- 2nd ~ 10th Row = Data
**Data contains DIFFERENT NAMES, and SAME NAME may occur MULTIPLE TIME per Column/Per Row..

EG. 30 Different Values
- Acura
- Audi
- Bentley
- BMW
- Buick
- Cadillac
- Chevrolet
- Chrysler
- Dodge
- Ferrari
- Fiat
- Ford
- Honda
- Infiniti
- Jagaur
- Jeep
- Kia
- Lexus
- Lincoln
- Mazda
- Mercedes-Benz
- Mini
- Mitsubishi
- Nissan
- Porsche
- Subaru
- Suzuki
- Toyota
- Volkswagen
- Volvo

What I need is to repeat the following tasks:

1) Out of all 45 names from
Sheet1 - Column A (9 names from A2~A10)
Sheet2 - Column A (9 names)
Sheet3 - Column A (9 names)
Sheet4 - Column A (9 names)
Sheet5 - Column A (9 names)
- Pick out the Car Manufacturers with ZERO VOTES from Survey (Another word, out of all 45 names, Pick out the names and INPUT THEM in the 1st ROW of the Sheet "Result")

2) Repeat, except Sheet5 move to Column B
Out of all 45 names from
Sheet1 - Column A (9 names from A2~A10)
Sheet2 - Column A (9 names)
Sheet3 - Column A (9 names)
Sheet4 - Column A (9 names)
Sheet5 - Column B (9 names)
- Input the car manufactuer/name that do not show up in the above 45 names in the 2ND Row of Sheet"Result"

3) Repeats.....UNTIL Sheet5's column is Column N (14TH Column)
Out of all 45 names from
Sheet1 - Column A (9 names from A2~A10)
Sheet2 - Column A (9 names)
Sheet3 - Column A (9 names)
Sheet4 - Column A (9 names)
Sheet5 - Column N (9 names)
- Input the car manufactuer/name that do not show up in the above 45 names in the 14TH Row of Sheet"Result"

and then,
Sheet1 - Column A (9 names from A2~A10)
Sheet2 - Column A (9 names)
Sheet3 - Column A (9 names)
Sheet4 - Column B (9 names)
Sheet5 - Column A (9 names)
- Input the car manufactuer/name that do not show up in the above 45 names in the 15TH Row of Sheet"Result"

and then..
Sheet1 - Column A (9 names from A2~A10)
Sheet2 - Column A (9 names)
Sheet3 - Column A (9 names)
Sheet4 - Column B (9 names)
Sheet5 - Column B (9 names)
................
4) Repeats...until
Sheet1 - Column N (9 names from A2~A10)
Sheet2 - Column N (9 names)
Sheet3 - Column N (9 names)
Sheet4 - Column N (9 names)
Sheet5 - Column N (9 names)
- Input the car manufactuer/name that do not show up in the above 45 names in the 537824TH Row of Sheet"Result"

To time the efficiency/speed of the macro, I have created a sheet called "Speed Evaluation" and use the following code to create a timestamp.
- "A1" states the starting time

Sheets("Speed Evaluation").select
Range("A1").FormulaR1C1 = "=NOW()"
Range("A1").value = Range("A1").Value

Open in new window

- "A2" states the finish time

Sheets("Speed Evaluation").select
Range("A2").FormulaR1C1 = "=NOW()"
Range("A2").value = Range("A2").Value

Open in new window

Any help would be greatly appreciated~

Thanks.

WiilingToPaypalAGoodCoder

ASKER

P.S. From my original macro created through macro recorder, I understand it is not possible to quickly test the code.

Hence, please feel free to change the macro with the assumption that there are less columns of data (maybe 5 columns?) in each sheet and indicate/comment in the macro so the efficiency can be tested .

I am definitely willing to paypal to the most efficient code/fastest code.

Thanks

andrewssd3

So do you want each row in results to contain a list of the makes that do NOT appear in the list of 45 you specified? Would it be one per column, with a variable number of columns per row, or just one cell with them all strung together? Is the list of 30 at the top the full list from which the missing ones should be picked?

WiilingToPaypalAGoodCoder

ASKER

Hi Andrew,

Thanks for the reply.

" So do you want each row in results to contain a list of the makes that do NOT appear in the list of 45 you specified? "

YES. So for example, if "Honda", "Toyota", "Chrysler" don't show up in the first Combination.
Then on the "Result" Sheet, it would show
A1 = Honda, B1 = Toyota, C1 = Chrysler
and then, if Porsche, Honda, Jeep don't show up in the second run, then on the "Result" sheet, it would show
A2 = Porsche, B2 = Honda, C3 = Jeep

and so on...

"Would it be one per column, with a variable number of columns per row, or just one cell with them all strung together?"

With my above's explanation, it would be 1 per column. ((Preferably))
My assumption is that, it's easier to play around with the result data afterwards?
((eg. search for/delete duplicate rows containing same car makes...etc etc)

"Is the list of 30 at the top the full list from which the missing ones should be picked?"
If i understand correctly, YES.
Basically, "full list of 30" - "all the manufacturers shown up in the combination" = "unpicked manufacturers" <<which go to the "Result' sheet.>>

andrewssd3

Let me say first, I don't want money - points would be good though! It's an interesting question. Here is one effort - I think this will be one of the best techniques as it does everything with arrays, and only dumps it back to the results sheet at the last minute.

This does not quite do what you asked, but it is quick - 2 seconds on my Excel 2010 64-bit machine for your 10-column data. This outputs a table with the counts for each make on each row. I'm not sure if you can use the data in this format. I'll revise it now just to output the makes with no votes as you asked, but it will be much slower, because the output will have to be written one cell at a time, and this what slows VBA down. I'll post that code in a moment.

It's as flexible as I could make it, but it is dependent on have exactly 5 sheets - it's difficult to make the looping work if you don't know how many times to loop. Anyway, you could not have many more sheets, as the numbers would start to get too big to be dealt with by Excel.

Public Sub RunAnalysis()

    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
    
Sheets("Speed Evaluation").Select
Range("A1").FormulaR1C1 = "=NOW()"
Range("A1").Value = Range("A1").Value

    
    lngNumSheets = 5
    strLookupTableStart = "A12"
    
    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 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
    
Sheets("Speed Evaluation").Select
Range("A2").FormulaR1C1 = "=NOW()"
Range("A2").Value = Range("A2").Value
    
End Sub

Open in new window

andrewssd3

Sorry should have posted the sheet - it has a couple of helping things - I have listed the makes on the working tab, and have used a lookup table to index the makes in the arrays, to avoid having to do expensive string comparisons. Car-Survey.xlsm Car-Survey.xlsm

andrewssd3

Accidentally embedded that twice - there's no difference between the two

ASKER CERTIFIED SOLUTION

andrewssd3

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

andrewssd3

Code for this version is as follows:

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
    
Sheets("Speed Evaluation").Select
Range("A1").FormulaR1C1 = "=NOW()"
Range("A1").Value = Range("A1").Value

    
    lngNumSheets = 5
    strLookupTableStart = "A12"
    
    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 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
    
Sheets("Speed Evaluation").Select
Range("A2").FormulaR1C1 = "=NOW()"
Range("A2").Value = Range("A2").Value
    
End Sub

Open in new window

WiilingToPaypalAGoodCoder

ASKER

Wow, Andrew.

This is CRAZY! I don't know know how you do it (i mean, I REALLY DON'T...I read the code and I have NO IDEA what they are about. I can understand what the macro recorder records.. but your code is like Chinese to me <and, No, I don't speak chinese =p>), it really is fast! Even on my underpowered laptop, it still managed to finish everything in 1 minute with the first file.

Since I can't understand the code much, I have several questions (and trust me, I feel bad for asking you more questions as you have saved me so much time but I am still asking you using up your time):

But I have to say, I like both Version 1 & Version2 as Version1 is versatile, where version is "cleaner" looking.

1) For your posts about the 2nd version of the excel, you mentioned
"I have not tested this thoroughly, but the results look OK. The are a couple of sequences where none have zero votes, so the entire row is empty. "
is that limited to the 2nd version? is the 1st version okay? ((i DID to a silly test with a first version, I manually copied/pasted the data for 5 combinations, and did a simple countif on each car makes, they do look the same)

2) I think with the 1st file being more versatile and quicker, it gives me the potential to add more survey results to the workbook. Now, I understand you mentioned that I can only work with 5 Sheets.

The Question is: Given the speed of this awesome macro, can I:
a) Increase the number of carmakes? (eg. from 30 to 50) <<I understand Sheets("working area") needs to be modified.
b) Increase the columns of each page? (eg. from 10 to 1000, for example)
c) Increase the rows of data? (eg. from 9 to 50)

*is it possible to make it a pop-up window so that I can specify the a,b,c each time?
** After I run the code, i notice from row 12~row 20 on each sheet generates a total count of each carmake, would that be affected if the rows of data's increased?

3) Currently, your amazing macro finishes so fast and 100,000 is generated.
If it IS possible to proceed with my wishful thinking with #2, then the results would so much more results will be generated which could possibily exceed 1,048,576 ROWS that excel has.
Hence, is it possible to

a) set a condition on WHEN to generate result (applicable to version2 only?)
eg. only generate result when "x amount" or more carmakes have zero vote. (pop-up window possible?)

b) extend more space for "Result" IF it ever exceed 1,048,576 ROWS
eg. input results in some columns to the right on "Result" sheet, or/and create "Result2", "Result3"...so on to input more results.

Once again, I really appreciate your help, and I really would like to thank you for the effort which saves me so much more time (the for/loop that i had before took forever). I really would like to paypal you if possible.

Thanks for your amazing help

WiilingToPaypalAGoodCoder

ASKER

Hi Andrew,

Sorry to trouble you again. As I am trying to understand the code, I realize I have a 4th question.

4) In the comment, there's a line where you state

' get the number of rows and cols (assume all tables are same dimensions)

I'm sure that means the data is always "rectangular". (9R x 10C) with the exisiting data.
I am just wondering, if it's possible to have, 'irregular shaped' data?
EG. Column B has 13 car manufacturers, column D has 15 manufactuers..etc etc?

It is okay if it cannot be or it is too troublesome. We will just make the survey less flexible. I would just like to make sure.

Once again, thank you so much for your time and effort.

andrewssd3

1) - no I think that's the case with both versions - it just means in the first version there should be a row where none of the counts is 0
2) a) No problem increasing the number of makes - just add more to the list and the code should handle it
b) the columns in principle is fine as the macro detects them, but in practice this is where things will start to get too big as the number of rows is defined by (columns ^ sheets), so when you get to 16 columns you are right at the limit of Excel 2007 rows - 1,048,576
c) Should be no problem increasing the rows ( will just run longer)
The blocks I have put under the tables on each sheet are not counts - they are the index numbers of the make from the table on the working area sheet - as I said in a previous comment, I use that rather than the names for speed - the number is the index to the column in the output array.
3) a) - that's a good idea, you could get over the rows limit that way
b) this is possible just a bit fiddly, and I guess it would make your results more difficult to use
4) No it does currently assume that the table on each sheet will have the same number of rows and columns. This would not be too difficult to change, but I would need somewhere to put the table of index values I mention above, and this should preferably be in a consistent location.

Finally you will start to get problems with the dimensions of the result array as things get bigger. There was a previous question about this which I'll look up and see where the limits would come. Basically VBA will start giving out of memory errors if the array is too big.

andrewssd3

Yes - this was the previous question: Q_27388703. I found that for an array of integer such as we have here my machine blows up at about 99,000,000 elements in total. As the array has (columns^sheets) rows and (number of makes) columns, if you increase the number of car makes to 50, you could have about 18 columns, although that would blow the Excel row limit. My machine is 64-bit with 6MB of RAM, and it's possible your limits would be lower.

WiilingToPaypalAGoodCoder

ASKER

Andrew is awesome and very knowledgeable. The feedback is also very prompt.
Thank you very much for the help.