Stephen_IV
Well-known Member
- Joined
- Mar 17, 2003
- Messages
- 1,174
- Office Version
- 365
- 2019
- Platform
- Windows
I need VBA assistance. I am using a dictionary to count data. My friend came up with the code below. I am just learning. I have my key as Column A I need to have the item be column B and C to put the output that i need. I am stuck. Any help would be appreciated.
VBA Dic Item Mult Cols.xlsm | |||||
---|---|---|---|---|---|
A | B | C | |||
1 | Facility | Sanction Type (primary) | Sanction Type (secondary) | ||
2 | 144020 | 1070 | 0 | ||
3 | 147816 | 1071 | 0 | ||
4 | 143419 | 1010 | 0 | ||
5 | 143419 | 1064 | 9999 | ||
6 | 141416 | 1010 | 0 | ||
7 | 147611 | 1020 | 0 | ||
8 | 147611 | 1020 | 0 | ||
9 | 147611 | 1061 | 0 | ||
10 | 147611 | 1020 | 1054 | ||
11 | 141120 | 1069 | 0 | ||
12 | 142520 | 1065 | 0 | ||
13 | 147916 | 1066 | 0 | ||
14 | 144219 | 1076 | 1000 | ||
15 | 142919 | 1070 | 0 | ||
16 | 142919 | 1065 | 0 | ||
17 | 147611 | 1020 | 1010 | ||
18 | 147611 | 1020 | 1010 | ||
Sheet1 |
|
VBA Code:
Option Explicit
Public Sub main()
Dim lastrow As Long
Dim r As Range
lastrow = Cells(Rows.count, "A").End(xlUp).Row
Set r = Sheets("Sheet1").Range("A2:A" & lastrow)
Dim dic As New Dictionary
Dim dic2 As New Dictionary
Dim dic3 As New Dictionary
Dim dic4 As New Dictionary
Dim dic5 As New Dictionary
Dim xcell
Dim cell
Dim i As Long
Dim j As Long
Dim n As Long
Dim y
For Each cell In r
If Not dic.Exists(Trim(cell.Text)) Then
dic.Add Trim(cell.Text), New Dictionary
End If
Set dic2 = dic(Trim(cell.Text))
If Not dic2.Exists(Trim(cell.Offset(0, 1).Text)) Then
dic2(Trim(cell.Offset(0, 1).Text)) = 0
End If
If Not dic5.Exists(Trim(cell.Offset(0, 2).Text)) Then
dic5(Trim(cell.Offset(0, 2).Text)) = 0
End If
dic2(Trim(cell.Offset(0, 1).Text)) = dic2(Trim(cell.Offset(0, 1).Text)) + 1
dic5(Trim(cell.Offset(0, 2).Text)) = dic5(Trim(cell.Offset(0, 2).Text)) + 1
dic3(Trim(cell.Offset(0, 1).Text)) = Trim(cell.Offset(0, 1).Text)
dic5(Trim(cell.Offset(0, 2).Text)) = Trim(cell.Offset(0, 2).Text)
Next
j = 2
For Each cell In dic3.Keys
Sheet2.Cells(1, j).Value = cell
j = j + 1
Next
i = 2
For Each cell In dic.Keys
j = 2
Sheet2.Cells(i, 1).Value = cell
Set dic4 = dic(cell)
Dim k
For Each k In dic3.Keys
Dim count As Integer
count = 0
If (dic4.Exists(k)) Then count = dic4(k)
Sheet2.Cells(i, j).Value = count
j = j + 1
Next
i = i + 1
Next
End Sub