PDA

View Full Version : Solved: UF Count Tally



Emoncada
05-30-2012, 06:15 AM
I'm trying to have a userform display a Total count and I'm a little stumped on how I can make this happen.

I have a Sheet("Totals") with column B having a list of models.

What I would like is have it grab Range B1: LastRow and then comes the hard part.

I want it to tell me the model and how many there are.

So Example.
Column B

DC7100
DC7100
Dell 1920
DC7100
DC7200

Then I would like to show on a UserForm

DC7100 - 3
Dell 1920 - 1
DC7200 - 1

I am not sure if I need to get the total to be displayed on the "Totals" sheet first then pull that info into the UF, or If it can be done straight into the Userform.

Any ideas?

shrivallabha
05-30-2012, 08:35 AM
Try this:
Private Sub UserForm_Initialize()
Dim objDic As Object
Dim vList As Variant

Set objDic = CreateObject("Scripting.Dictionary")

With objDic
.CompareMode = TextCompare
For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
If .Exists(Range("B" & i).Value) Then
.Item(Range("B" & i).Value) = .Item(Range("B" & i).Value) + 1
Else
.Add Range("B" & i).Value, 1
End If
Next i
vList = Application.Transpose(Array(.Keys, .Items))
End With

Set objDic = Nothing

With Me.ListBox1 'Change this listbox reference to suit
.ColumnCount = 2
.List = vList
End With

End Sub

Emoncada
05-30-2012, 08:41 AM
WWWWOOOOWWWW.
Shrivallabha, that is amazing.

Thank you so much.

Can this be done without the user being on "Totals" sheet?
Like have this run with the "Totals" sheet not being the active sheet?

BrianMH
05-30-2012, 09:40 AM
Private Sub UserForm_Initialize()
Dim objDic As Object
Dim vList As Variant
dim stTotals as worksheet
'change this to suit
set stTotals = thisworkbook.sheets("Totals")
Set objDic = CreateObject("Scripting.Dictionary")

With objDic
.CompareMode = TextCompare
For i = 1 To stTotals.Range("B" & Rows.Count).End(xlUp).Row
If .Exists(stTotals.Range("B" & i).Value) Then
.Item(stTotals.Range("B" & i).Value) = .Item(stTotals.Range("B" & i).Value) + 1
Else
.Add stTotals.Range("B" & i).Value, 1
End If
Next i
vList = Application.Transpose(Array(.Keys, .Items))
End With

Set objDic = Nothing

With Me.ListBox1 'Change this listbox reference to suit
.ColumnCount = 2
.List = vList
End With

End Sub


This should work

Emoncada
05-30-2012, 10:14 AM
Perfect. Thank you Shrivallabha, for you code.
Thank you BrianMH for adding the finishing touch.

Thanks Again.