```
Sub Summarize()
Dim key1 As String, key2 As String
Dim Loc As String, Mat As String
Dim nRow As Long
Dim key As Variant
Dim cell As Range, rngLoc As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wb1 As Workbook, wb2 As Workbook
Dim dictMat As Object, dictN As Object
Set dictMat = CreateObject("Scripting.Dictionary")
Set dictMat = CreateObject("Scripting.Dictionary")
Set wb1 = ActiveWorkbook
Set ws1 = wb1.Sheets("Sheet1")
Workbooks.Add.SaveAs Filename:=wb1.Path & "\" & "WB2"
Set wb2 = ActiveWorkbook
Set rngLoc = ws1.Range("A2", ws1.Cells(Rows.Count, "A").End(xlUp))
dictMat.RemoveAll
For Each cell In rngLoc
key1 = cell.Value & " " & cell.Offset(, 1).Value
key2 = cell.Value & " " & cell.Offset(, 2).Value
If dictMat.Exists(key1) Then
dictMat(key1) = dictMat(key1) + 1
Else
dictMat.Add key1, 1
End If
If Not dictMat.Exists(key2) Then
dictMat(key2) = dictMat(key2) + 1
End If
Next
For Each key In dictMat
Loc = Split(key)(0)
Mat = Split(key)(1)
If SheetExist(wb2, Loc) Then
Set ws2 = wb2.Sheets(Loc)
With ws2
If Left(Mat, 1) = "N" Then
.Range("B2") = .Range("B2") + dictMat(key)
Else
nRow = .Cells(Rows.Count, "A").End(xlUp).Offset(1).Row
.Range("A" & nRow) = Mat
.Range("B" & nRow) = dictMat(key)
End If
End With
Else
wb2.Sheets.Add(After:=wb2.Sheets(wb2.Sheets.Count)).Name = Loc
Set ws2 = wb2.Sheets(Loc)
With ws2
If .Range("A1") = "" Then .Range("A1") = Loc
.Range("A2") = "Node"
.Range("B1") = "Qty"
If Left(Mat, 1) = "N" Then
.Range("B2") = .Range("B2") + dictMat(key)
Else
nRow = .Cells(Rows.Count, "A").End(xlUp).Offset(1).Row
.Range("A" & nRow) = Mat
.Range("B" & nRow) = dictMat(key)
End If
End With
End If
Next
SortSheetsTabs wb2
End Sub
Function SheetExist(wb As Workbook, Loc As String) As Boolean
Dim n As Long, nLoc As Long, nSht As Long, nMin As Long
Dim ws As Worksheet
For Each ws In wb.Sheets
If ws.Name = Loc Then
SheetExist = True
End If
Next
End Function
Sub SortSheetsTabs(wb As Workbook)
Dim nSht As Long, i As Long, j As Long
nSht = Sheets.Count
For i = 1 To nSht - 1
For j = i + 1 To nSht
If UCase(Sheets(j).Name) < UCase(Sheets(i).Name) Then
Sheets(j).Move Before:=Sheets(i)
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
```