Unique Combination of Values from 3 Columns

[TonyJamesTroiano]

I'm trying to create a set of VBA modules to auto format some raw data for a regular review.
My first big hurdle is to extract the unique combinations of Customer Name, vehicle type, and Sleeper Code for the vehicles the customer currently has leased from us.

Sub UniqueCustomerVehiclesList()
Dim X
Dim objDict As Object
Dim lngRow As Long
Sheets("MYFleetProfile").Select
Set objDict = CreateObject("Scripting.Dictionary")
X = Application.Transpose(Range([A1:A1], Cells(Rows.Count, "A").End(xlUp)))

For lngRow = 1 To UBound(X, 1)
    objDict(X(lngRow)) = 1
Next
Sheets("BuildReport").Select
Range("A1:A" & objDict.Count) = Application.Transpose(objDict.keys)
Columns("A:A").Select

I am successfully getting a single column of unique values from this code and can bounce the pointer to any of the 3 identifier columns.

 

[DocAElstein]

Hi TonyJamesTroiano
I have no idea what you are asking here?. I only see a code in this Thread, and your brief description.

I'm trying to create a set of VBA modules to auto format some raw data for a regular review.
My first big hurdle is to extract the unique combinations of Customer Name, vehicle type, and Sleeper Code for the vehicles the customer currently has leased from us.......

I am successfully getting a single column of unique values from this code and can bounce the pointer to any of the 3 identifier column......

Maybe you have tried to post images? Sometimes they come up and sometimes not depending on which browser people use. ...


_ In any case, Try and give a Before and After “Picture” BUT NOT IMAGES! of what you have and what you want.

_ . Make sure there is just enough data to demonstrate your need. Remember to desensitize the data if necessary, but use the typical Format type and choose your data carefully so that it can be used to test all possible scenarios.

_ ............

Some Notes for producing a good Before and After “Picture” in a MrExcel Thread:

Method _1) is preferred here at MrExcel so that everyone looking in on the thread can easily see what is going on.

_ . 1) – Post screenshots capable of being copied to an Excel Spreadsheet ( see notes for how to do that in my signature –Please do not post am image as we cannot copy that to a spreadsheet!)
_ . or
_ . 2) - Up left in the Thread editor is a Table icon. Click that, create an appropriately sized table and fill it in. (To get the table icon up in the Reply window you need to click on the “Go Advanced” Button next to the Reply Button)
_ . or
_ .3 ) – attach a File with at least two sheets, - a “Before” and an “After” )
_ . For example send over this free thing:
https://app.box.com/signup/personal
_ .Remember to select Share after uploading and give us the link they provide.
_ . or , only as a very last resort please.
_ .4 ). – Private Message me, and I will reply with my E-mail address and you can contact me and attach a File.( To Private Message me: ---You must be logged in. ---Click on my name DocAElstein above the Picture in the left margin. ---Select Private Message. –The rest should be obvious

Alan

 

[Peter_SSs]

Welcome to the MrExcel board!

It seems to me that you are saying you have that code to successfully create a unique list for any one column but you want a unique list of combinations from 3 columns.

If that is so then you could try this in a copy of your workbook.

I could not tell what three columns the Customer Name etc was in so I have used columns K:M. If that is not it and you are not able to adjust the code for that then post back with details.

Note that (mostly) you don't need to select sheets (or other objects) to work with them in vba and the selection process slows your code.

Sub UniqueCustomerVehiclesCodeList()
  Dim X, vRws
  Dim objDict As Object
  Dim lngRow As Long, lngLastRow

  Set objDict = CreateObject("Scripting.Dictionary")
  objDict.CompareMode = 1
  With Sheets("MYFleetProfile")
    lngLastRow = .Range("K" & .Rows.Count).End(xlUp).Row
    vRws = Evaluate("row(2:" & lngLastRow & ")")
    X = Application.Index(.Cells, vRws, Array(11, 12, 13))  '11, 12, 13 are columns K, L, M
  End With
  For lngRow = 1 To UBound(X, 1)
    objDict(X(lngRow, 1) & "|" & X(lngRow, 2) & "|" & X(lngRow, 3)) = 1
  Next
  With Sheets("BuildReport")
    .UsedRange.Resize(, 3).ClearContents
    With .Range("A1:A" & objDict.Count)
      .Value = Application.Transpose(objDict.keys)
      .TextToColumns Destination:=.Cells(1), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                     ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
                     Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
                     TrailingMinusNumbers:=True
    End With
  End With
End Sub

 

[TonyJamesTroiano]

Thank you for the helpful tips Alan. I will be sure to follow your advice in posting my next request.

 

[TonyJamesTroiano]

Peter -
Thank you very much! It worked wonderfully! I will be doing a bit of studying to understand the use of the arrays that enabled your solution. Also, thank you for the helpful tips at the end of your code.
Sincerely, Tony

 

[DocAElstein]

You is very welcome.
Glad we could help
Thanks for the Feedback
Alan

( Good luck with installing the Tools"

 

[Peter_SSs]

Peter -
Thank you very much! It worked wonderfully! I will be doing a bit of studying to understand the use of the arrays that enabled your solution. Also, thank you for the helpful tips at the end of your code.
Sincerely, Tony

You are welcome. Glad it helped. Thanks for letting us know.