VBA Collection

[KDEBR]

Hi,
I have a large list in excel that contains diesel and petrol cars.
I have to verify if there is an alternative petrol car for each available diesel car.
Therefore I first filtered the basic list with all vehicles and made 2 tabs (1 with diesel and another with petrol).
afterwards I take the first diesel car and look for the alternative in petrol. Because there are multiple fuel versions I want to select the fuel version that is the nearest to the diesel variant.
Therefore I copy the matching petrol cars and put them in another tab(workfile) by ordering them descending. Then I look for an equivalent horsepower of diesel horsepower - 5.
The resulting lease price I copy and put it next to the diesel car.

Is there a more efficient way by working with a collection so that I don't have to copy the corresponding petrol cars to a new tab?
this is slowing down the macro reaction time. Because each time I filter the petrol list copy the results in a new tab and afterwards I remove the filter on the petrol list and empty the worksheet file. So I'm looking for a more efficient solution here.

In java you can work for example with collections/Array could this be a solution? and what is the alternative for VBA?

thanks!

 

[Worf]

Welcome to the Board

Some available tools are: advanced filter, collections, arrays, formulas and the scripting dictionary. For a large list, the dictionary should be fast, but I need to know how many list fields we are going to manipulate.
Can you post some sample data, showing how your source table is organized?

 

[KDEBR]

Hello,

Below you can find some sample data. I have a large list that contains diesel and petrol cars. For each diesel car I want to find a corresponding petrol if there is an equivalent available.
Therefore in column A I made a unique code. Afterwards I try to match based on the KW (is there an equivalent with same KW or a petrol variant with max 5 kw lower).
Example data below:

Vehicule code Motor Type Kw HP Gearbox Vehicle Catalog Price (VAT excl.) "TCO
incl. Energy" Vehicle code
VOLKSWAGEN PASSAT Berline Manual Diesel 110 Manual 28636,36 619,01 VOLKSWAGEN PASSAT Berline Manual
VOLKSWAGEN PASSAT Berline Manual Diesel 110 Manual 26694,21 592,6 VOLKSWAGEN PASSAT Berline Manual
VOLKSWAGEN PASSAT Berline Manual Petrol 110 Manual 25330,58 564,42 VOLKSWAGEN PASSAT Berline Manual
VOLKSWAGEN PASSAT Berline Manual Petrol 110 Manual 27272,73 590,46 VOLKSWAGEN PASSAT Berline Manual
VOLKSWAGEN PASSAT Berline Manual Petrol 110 Manual 28111,57 592,75 VOLKSWAGEN PASSAT Berline Manual
VOLKSWAGEN PASSAT Berline Manual Petrol 110 Manual 26801,65 574,32 VOLKSWAGEN PASSAT Berline Manual
VOLKSWAGEN PASSAT Berline Manual Diesel 110 Manual 28165,29 602,69 VOLKSWAGEN PASSAT Berline Manual
VOLKSWAGEN PASSAT Berline Manual Diesel 110 Manual 29475,21 621,37 VOLKSWAGEN PASSAT Berline Manual



What I currently do in my Macro is making two list in 2 tabs (1 with diesel and 1 with petrol cars).
Than I look for every diesel car if there is a petrol version. therefore I put an autofilter on the petrol cars list and look for an alternative. I copy that selection to a new tab and sort it descending on KW.
Than I look for the same KW or a version with max - 5 compare to the diesel car.
I think that the copy of this selection, sorting it and deleting it afterwards makes the marcro very slow.
Therefore I would like to know if I could work with collections like in Java for example. As I just need the TCO amount, and quote ID for the petrol car. So if I could do this check in memory it would be more efficient I think.

thanks for your feedback!

 

[Worf]

• Thanks for the sample data. Unfortunately, it is a bit unformatted; I am not sure what information goes into what columns. For example, “manual” appears three times but “gearbox” appears only once in the header. You could take a screenshot of the range, showing the column labels, upload it to a hosting site and paste a link here. I would recommend Excel Jeanie but the English version link seems to be broken today.
• Are you using VLOOKUP to search the kW column? Note that this function accepts array arguments.
• We will need an efficient sorting algorithm.
• After getting the exact data table I will see it the task is suitable for the scripting dictionary. Another option could be ADO, or just transfer the worksheet list to a VBA array and perform the calculations there.

 

[KDEBR]

Hello
I hope this is better? How could I paste it as an image because he asks for a link?

Vehicle code	Motor Type	Kw HP	Vehicle Catalog Price	TCO incl. Energy
VOLKSWAGEN PASSAT Berline Manual	Diesel	110	28636,36	619,01
VOLKSWAGEN PASSAT Berline Manual	Diesel	88	25421,49	537,07
VOLKSWAGEN PASSAT Berline Manual	Diesel	88	24785,12	529,43
VOLKSWAGEN PASSAT Berline Manual	Diesel	110	26694,21	592,6
VOLKSWAGEN PASSAT Berline Manual	Diesel	88	27363,64	562,78
VOLKSWAGEN PASSAT Berline Manual	Diesel	88	25421,49	524,4
VOLKSWAGEN PASSAT Berline Manual	Diesel	88	28202,48	565,11
VOLKSWAGEN PASSAT Berline Manual	Diesel	88	26892,56	546,94
VOLKSWAGEN PASSAT Berline Manual	Diesel	110	28165,29	602,69
VOLKSWAGEN PASSAT Berline Manual	Diesel	110	29475,21	621,37
VOLKSWAGEN PASSAT Berline Manual	Petrol	110	25330,58	564,42
VOLKSWAGEN PASSAT Berline Manual	Petrol	110	27272,73	590,46
VOLKSWAGEN PASSAT Berline Manual	Petrol	110	28111,57	592,75
VOLKSWAGEN PASSAT Berline Manual	Petrol	110	26801,65	574,32

<colgroup><col><col><col><col><col></colgroup><tbody>
</tbody>

I don't use a vlookup. As I create based on the sample above two extra tabs: 1 with diesel and 1 with petrol vehicles.
Than I match the vehicle code of the first diesel car with the petrol vehicles. therefore I use an autofilter in the petrol list. Afterwards I sort the petrol list descending on KW and I loop for an exact match with the KW for the diesel car. If no match I ll check if there is a petrol with < 5 KW.
Than I copy the TCO value into the diesel list to have a corresponding diesel and petrol TCO (or no match).

I hope this makes it more clear?

thanks!

 

[Worf]

• Yes, I can understand the table now. To post an image,you have to upload it to a site like Imgur and paste a link to it here. It can be displayed as the picture itself or an Internet address.
• As the issue is efficiency, I will try to keep looping to a minimum.
  

 

[KDEBR]

Hello,

here you can find some sample data
https://1drv.ms/x/s!ApFrSgAA6iNJgQtUmJBe_wSfWLPU

In the tab result I've added in column P and Q the result of the matching (for the corresponding diesel vehicle he has filtered the petrol list based on vehicle code and looked for the same KW or <5).

thanks

 

[Worf]

Please test the code below; I am also posting a link to the workbook.
Tags: Excel VBA ADO filter

https://www.dropbox.com/s/zpe5xvlmnwb8cfh/cars.xlsm?dl=0

Sub Ado()
Dim i%, cnStr$, rs As ADODB.Recordset, query$, v, resq, rest, lr&
Sheets("data").Activate
lr = Range("a" & Rows.Count).End(xlUp).Row
cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & ThisWorkbook.Path & _
"\" & ThisWorkbook.Name & ";" & "Extended Properties=Excel 12.0"
For i = 2 To lr
    If Cells(i, 10) = "Diesel" Then
        query = "SELECT * FROM [" & ActiveSheet.Name & "$" & "a1:o" & lr & "]" & _
        "WHERE (Vcode LIKE '" & Cells(i, 1) & "')" & "AND (Mtype LIKE 'Petrol')"
        Set rs = New ADODB.Recordset
        rs.Open query, cnStr, adOpenStatic, adLockReadOnly
        rs.Filter = "kwhp >" & Cells(i, 12) - 5 & " and kwhp <" & Cells(i, 12) + 5  ' restrict kW search
        Select Case rs.EOF
            Case True
                Cells(i, 17) = "No equivalent petrol car in KW range"
            Case False
                rs.MoveFirst
                v = Abs(rs!kwhp - Cells(i, 12))
                resq = rs!Quote_ID
                rest = rs!TCO_Energy
                Do While Not rs.EOF                                                 ' find closest kW
                    If Abs(rs!kwhp - Cells(i, 12)) < v Then
                        v = Abs(rs!kwhp - Cells(i, 12))
                        resq = rs!Quote_ID
                        rest = rs!TCO_Energy
                    End If
                    rs.MoveNext
                Loop
                Cells(i, 16) = resq                                                 ' write to data sheet
                Cells(i, 17) = rest
        End Select
    End If
    Set rs = Nothing
Next
End Sub

 

[mse330]

Hi KDEBR,

This is another code to consider where the results are matching to Worf's above code but runs much quicker (which I believe this is what you are trying to achieve) since it is accessing the worksheet less frequent. Anyway, let us know if the codes are working for you

Sub Find_Alternative()
Dim Ar1() As Variant, Ar2() As Variant, vCode As String, KW_HP As Integer, Cnt As Long
Ar1 = ActiveSheet.Range("A1", ActiveSheet.Range("O" & Rows.Count).End(xlUp)).Value
ReDim Ar2(1 To UBound(Ar1), 1 To 2)
For x = 2 To UBound(Ar1)
    Cnt = Cnt + 1
    If Ar1(x, 10) = "Diesel" Then
        vCode = Ar1(x, 1)
        KW_HP = Ar1(x, 12)
        For y = 2 To UBound(Ar1)
            If Ar1(y, 1) = vCode And Ar1(y, 10) = "Petrol" And (Ar1(y, 12) = KW_HP Or Abs(Ar1(y, 12) - KW_HP) <= 5) Then
                Ar2(Cnt, 1) = Ar1(y, 2)
                Ar2(Cnt, 2) = Ar1(y, 15)
                Exit For
            Else
                Ar2(Cnt, 2) = "No equivalent petrol car in KW range"
            End If
        Next y
    End If
Next x
With ActiveSheet
    .Range("P1:Q1") = Array("Quote_ID_Petrol", "TCO Petrol")
    .Range("P2").Resize(UBound(Ar1), 2).Value = Ar2
End With
End Sub

 

[KDEBR]

this works fine !

thanks for the feedback!