How to select unique values from different columns in different worksheets using VBA? - vba

Question

I have a workbook in which there are 5 sheets :
prize
volatility
size
value
growth
These five sheets have a ticker list (stocks name on index) in columns along with the dates . After every three months a new ticker list comes as a result of rebalancing for e.g. PRIZE sheet is having 2 rebalances so 2 ticker lists and SIZE sheet is having 4 rebalances so 4 ticker lists, so all these ticker lists are presented in the five different sheets. I want to make a macro which picks distinct unique values from these lists and paste it in another sheet in one column.

Answer 1

This will require a reference to the Microsoft Scripting Runtime. Go to the VB Editor, then Tools, References and select it from there.
After that, paste this code in a proc and see if it gets you over the line. It'll certainly push your knowledge in a new direction - dictionaries and arrays are amazing things in the right hands and utterly doom-laden in the wrong hands. You've been warned...!
Dim dctUniqueTickers As Dictionary
Dim dctTickerLocations As Dictionary
Dim arrCurrentTickerRange As Variant
Dim arrTickerOutput As Variant
Dim varSheetNames As Variant
Dim lngDctCounter As Long
Dim lngRowCounter As Long
Dim lngColCounter As Long
Dim lngAreaCounter As Long
' Set up the ticker location range(s)
Set dctTickerLocations = New Dictionary
With dctTickerLocations
.Add "prize", Application.Union(ThisWorkbook.Worksheets("prize").Range("A:A"), _
ThisWorkbook.Worksheets("prize").Range("C:C"))
.Add "size", Application.Union(ThisWorkbook.Worksheets("size").Range("A:A"), _
ThisWorkbook.Worksheets("size").Range("E:E"), _
ThisWorkbook.Worksheets("size").Range("F:F"), _
ThisWorkbook.Worksheets("size").Range("H:H"))
End With
' Populate the destination dictionary
Set dctUniqueTickers = New Dictionary
For Each varSheetNames In dctTickerLocations.Keys
' Looping through the keys (the worksheet names), pick up the associated range(s)
' - there may be multiple areas to consider
For lngAreaCounter = 1 To dctTickerLocations(varSheetNames).Areas.Count
arrCurrentTickerRange = dctTickerLocations(varSheetNames).Areas(lngAreaCounter)
For lngRowCounter = LBound(arrCurrentTickerRange, 1) To UBound(arrCurrentTickerRange, 1)
For lngColCounter = LBound(arrCurrentTickerRange, 2) To UBound(arrCurrentTickerRange, 2)
If LenB(arrCurrentTickerRange(lngRowCounter, lngColCounter)) > 0 Then
If Not dctUniqueTickers.Exists(arrCurrentTickerRange(lngRowCounter, lngColCounter)) Then
' Ticker not found within the dictionary, so add it
dctUniqueTickers.Add arrCurrentTickerRange(lngRowCounter, lngColCounter), arrCurrentTickerRange(lngRowCounter, lngColCounter)
End If
End If
Next
Next
Next
Next
If dctUniqueTickers.Count > 0 Then
lngDctCounter = 0
' Now output
ThisWorkbook.Worksheets("OutputSheet").Range("A1").Value = "Unique tickers"
For Each arrTickerOutput In dctUniqueTickers.Keys
ThisWorkbook.Worksheets("OutputSheet").Range("A2").Offset(lngDctCounter, 0).Value = CStr(arrTickerOutput)
lngDctCounter = lngDctCounter + 1
Next
End If
By using arrays it's lightning-fast and the extra check for empty cells only improves performance.