Sub DemoListBox()
With Sheet3.Cells(1).CurrentRegion.Rows
If .Count = 1 Or .Columns.Count < 9 Then Beep: Exit Sub
VA = .Item("2:" & .Count).Columns("G:I").Value
End With
With CreateObject("Scripting.Dictionary")
For R& = 1 To UBound(VA)
If Not ((VA(R, 1) = 0 And VA(R, 2) = "") Or VA(R, 2) = 0) Then
For Each V In Split(VA(R, 3), ";")
V = Trim$(Split(V, "(")(0))
If V > "" Then .Item(V) = .Item(V) + 1
Next
End If
Next
Select Case .Count
Case 1: UserForm1.ListBox1.List = Evaluate("{""" & .Keys()(0) & """," & .Items()(0) & ";"""",""""}")
Case Is > 1: UserForm1.ListBox1.List = Application.Transpose(Array(.Keys, .Items))
End Select
.RemoveAll
End With
UserForm1.Show
End Sub