Numeric Identifiers for Multiple Groups (vba?)

ajcormac · Jun 6, 2014

Hi there,

Currently I have a set of data consisting of an unique identifier (ID), four product properties (Brand.1.1, Brand.1.2, ...), and a preference.

What I would like to do is for each product category (i.e. Brand, Price, and Preference) is assign numeric identifiers to values - that is, common values will be assigned the same identifier within each category. If possible, I would also like a legend to be created automatically. It is possible that the same input exists in different categories, but they should not be seen as equivalent to each other.

My current method involves creating a chart of unique values for each category and using lookup functions but this is a slow process when I have multiple product categories to go through (Size, Price, Brand, Warranty, Features, Delivery, etc.).

Example:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Brand.1.1[/TD]
[TD]Brand.1.2[/TD]
[TD]Price.1.1[/TD]
[TD]Price.1.2[/TD]
[TD]Preference[/TD]
[/TR]
[TR]
[TD]ID001[/TD]
[TD]Apple[/TD]
[TD]Cereal[/TD]
[TD]50[/TD]
[TD]25[/TD]
[TD]Cereal[/TD]
[/TR]
[TR]
[TD]ID002[/TD]
[TD]Cereal[/TD]
[TD]Bread[/TD]
[TD]32[/TD]
[TD]41[/TD]
[TD]Cereal[/TD]
[/TR]
[TR]
[TD]ID003[/TD]
[TD]Bread[/TD]
[TD]Apple[/TD]
[TD]50[/TD]
[TD]32[/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD]ID004[/TD]
[TD]Cereal[/TD]
[TD]Eggs[/TD]
[TD]41[/TD]
[TD]25[/TD]
[TD]Eggs[/TD]
[/TR]
</tbody>[/TABLE]

Assign numeric values:
[TABLE="class: grid, width: 500"]

<tbody>[TR]
[TD][/TD]
[TD]Brand.1.1[/TD]
[TD]Brand.1.2[/TD]
[TD]Price.1.1[/TD]
[TD]Price.1.2[/TD]
[TD]Preference[/TD]
[/TR]
[TR]
[TD]ID001[/TD]
[TD]1[/TD]
[TD]3[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]ID002[/TD]
[TD]3[/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]ID003[/TD]
[TD]2[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]3[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]ID004[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]4[/TD]
[TD]2[/TD]
[TD]3[/TD]
[/TR]
</tbody>
[/TABLE]

Legend:
Brand:
Apple - 1
Bread - 2
Cereal - 3
Eggs -4

Price:
$50 - 1
$25 -2
$32 -3
$41 -4

Preference: (Notice how it has same values as Brand but doesn't necessarily assign same numbers since it's a different category)
Cereal -1
Apple -2
Eggs -3

I imagine VBA will be required but any thoughts/help would be appreciated.

sijpie · Jun 11, 2014

This will do the trick, I have addded a lot of comments to make clear how it works:

Sub GetIdentifiers() ' ' Sub to make copy of input table and replace Brand, Price _ and Preference with index numbers. Then output legend to _ these numbers '=========================================================== Dim colBrand As Collection, colPrice As Collection, _ colPref As Collection Dim rIn As Range, rOut As Range, rC As Range Dim vArr As Variant Dim lR As Long Set colBrand = New Collection Set colPrice = New Collection Set colPref = New Collection ' get unique Brands Set rIn = Range("C3") ' first Brand cell below header Set colBrand = FillCollection(rIn, 2) ' get unique Prices Set rIn = Range("E3") ' first Price cell below header Set colPrice = FillCollection(rIn, 2) ' get Preferences Set rIn = Range("G3") ' first Preference cell below header Set colPref = FillCollection(rIn, 1) ' Create Numeric Table Set rIn = rIn.CurrentRegion Set rOut = rIn.Offset(rIn.Cells(1, 1).Row + rIn.Rows.Count + 2, 0) 'expand rOut to same size as rIn Set rOut = rOut.Resize(rIn.Rows.Count, rIn.Columns.Count) 'copy values to array for fast processing vArr = rIn.Value 'now replace values in vArr with index numbers GetIndexintoArray vArr, colBrand, 2, 2 GetIndexintoArray vArr, colPrice, 4, 2 GetIndexintoArray vArr, colPref, 6, 1 ' then output the vArr rOut.Value = vArr ' Now the Legend, two columns right of output table Set rOut = rOut.Cells(1, rOut.Columns.Count).Offset(0, 2) lR = Application.WorksheetFunction.Max(colBrand.Count, _ colPrice.Count, colPref.Count) ReDim vArr(1 To lR + 2, 1 To 8) ' reset array to correct _ size for legend table vArr(1, 1) = "Legend" vArr(2, 1) = "Brand:" vArr(2, 4) = "Price:" vArr(2, 7) = "Preference:" For lR = 1 To colBrand.Count vArr(lR + 2, 1) = colBrand.Item(lR) vArr(lR + 2, 2) = lR Next lR For lR = 1 To colPrice.Count vArr(lR + 2, 4) = colPrice.Item(lR) vArr(lR + 2, 5) = lR Next lR For lR = 1 To colPref.Count vArr(lR + 2, 7) = colPref.Item(lR) vArr(lR + 2, 8) = lR Next lR 'print out the legend rOut.Resize(UBound(vArr, 1), UBound(vArr, 2)).Value = vArr End Sub Function FillCollection(ByVal rStart As Range, ByVal lCol As Long) _ As Collection ' ' Function to get unique items into a collection. ' Returns the collection. ' Input: rStart is the first cell of range to get items from. _ lCol is the number of columns to use for input '==================================================================== Dim colCollection As Collection Dim vArr As Variant Dim lR As Long, lC As Long, lRows As Long Set colCollection = New Collection lRows = rStart.CurrentRegion.Rows.Count - 1 vArr = rStart.Resize(lRows, lCol) ' read values into array from rIn extended to end of table for lCol columns ' now loop through all elements in the array and add them to the collection. Only unique values will be added if we add the item twice first as the item, then as the key On Error Resume Next ' to avoid error when encountering duplicate For lR = LBound(vArr, 1) To UBound(vArr, 1) For lC = LBound(vArr, 2) To UBound(vArr, 2) colCollection.Add vArr(lR, lC), CStr(vArr(lR, lC)) Next lC Next lR On Error GoTo 0 ' reset error behaviour Set FillCollection = colCollection End Function Sub GetIndexintoArray(vArr As Variant, ByVal colColl As Collection, _ ByVal lCol As Long, ByVal lColCount As Long) ' ' Sub to change the values in array with the relevant index _ numbers taken from collection. _ Input: vArr is array with values, these will be replaced _ colColl is Collection with unique values _ lCol is start column in vArr to be processed _ lColCount is number of columns to be processed '==================================================================== Dim lR As Long, lC As Long, lRows As Long, lIndx As Long ' first row in vArr holds heading, don't process For lR = LBound(vArr, 1) + 1 To UBound(vArr, 1) For lC = lCol To lCol + lColCount - 1 For lIndx = 1 To colColl.Count If colColl.Item(lIndx) = vArr(lR, lC) Then vArr(lR, lC) = lIndx Exit For End If Next lIndx Next lC Next lR End Sub

Numeric Identifiers for Multiple Groups (vba?)

ajcormac

New Member

sijpie

Well-known Member

Similar threads

Share this page

Numeric Identifiers for Multiple Groups (vba?)

ajcormac

New Member

sijpie

Well-known Member

Similar threads

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock