dsubash
New Member
- Joined
- Nov 22, 2024
- Messages
- 35
- Office Version
- 2019
- Prefer Not To Say
- Platform
- Windows
I have the following code in my workbook, that generates report from the database in Sheet1 to the reports page in Sheet2.
I need the sum of rows from Col. G to Col. K starting from row 7 to end of report
Sub GetBranchProductsList()
Dim A, M, T&, Ta&, K&
Dim Dic1 As Object
Dim SortedBranches As Variant
Dim SortedProducts As Variant
Application.ScreenUpdating = False
' Load data from the sheet (columns A and B)
A = Sheets("Sheet1").Range("A1").CurrentRegion.Offset(1, 0).Resize(, 2)
' Initialize the dictionary to hold branch-product relationships
Set Dic1 = CreateObject("Scripting.dictionary")
With Dic1
For T = 1 To UBound(A, 1) - 1
If .exists(A(T, 1)) Then
' Append the product to the branch, ensuring no duplicates
If InStr(1, .Item(A(T, 1)), A(T, 2)) = 0 Then
.Item(A(T, 1)) = .Item(A(T, 1)) & "_" & A(T, 2)
End If
Else
' Add new branch-product entry
.Item(A(T, 1)) = A(T, 2)
End If
Next T
' Get the sorted list of branch names
SortedBranches = SortArray(Dic1.keys)
End With
' Start writing data to the sheet at O1
With Sheets("Sheet1").Range("O1")
.CurrentRegion.Offset(1, 0).Clear
.Value = "Branches"
' Write the sorted branches in column O starting from O2
.Offset(1, 0).Resize(UBound(SortedBranches) + 1, 1).Value = WorksheetFunction.Transpose(SortedBranches)
' Write the headers for products (same as branch names)
.Offset(0, 1).Resize(1, UBound(SortedBranches) + 1).Value = SortedBranches
' Write the products for each branch, sorted alphabetically
For Ta = 0 To UBound(SortedBranches)
M = Split(Dic1.Item(SortedBranches(Ta)), "_") ' Split products by "_"
SortedProducts = SortArray(M) ' Sort the products alphabetically
' Write the sorted products below each branch
If UBound(SortedProducts) >= 0 Then
.Offset(1, Ta + 1).Resize(UBound(SortedProducts) + 1, 1).Value = WorksheetFunction.Transpose(SortedProducts)
End If
Next Ta
End With
Application.ScreenUpdating = True
End Sub
' Function to sort an array alphabetically
Function SortArray(arr As Variant) As Variant
Dim i As Long, j As Long
Dim temp As Variant
' Bubble sort algorithm for sorting the array
For i = LBound(arr) To UBound(arr)
For j = i + 1 To UBound(arr)
If arr(i) > arr(j) Then
' Swap the elements
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
End If
Next j
Next i
SortArray = arr
End Function
any suggestions
Thanks in Advance
Subash D
I need the sum of rows from Col. G to Col. K starting from row 7 to end of report
Sub GetBranchProductsList()
Dim A, M, T&, Ta&, K&
Dim Dic1 As Object
Dim SortedBranches As Variant
Dim SortedProducts As Variant
Application.ScreenUpdating = False
' Load data from the sheet (columns A and B)
A = Sheets("Sheet1").Range("A1").CurrentRegion.Offset(1, 0).Resize(, 2)
' Initialize the dictionary to hold branch-product relationships
Set Dic1 = CreateObject("Scripting.dictionary")
With Dic1
For T = 1 To UBound(A, 1) - 1
If .exists(A(T, 1)) Then
' Append the product to the branch, ensuring no duplicates
If InStr(1, .Item(A(T, 1)), A(T, 2)) = 0 Then
.Item(A(T, 1)) = .Item(A(T, 1)) & "_" & A(T, 2)
End If
Else
' Add new branch-product entry
.Item(A(T, 1)) = A(T, 2)
End If
Next T
' Get the sorted list of branch names
SortedBranches = SortArray(Dic1.keys)
End With
' Start writing data to the sheet at O1
With Sheets("Sheet1").Range("O1")
.CurrentRegion.Offset(1, 0).Clear
.Value = "Branches"
' Write the sorted branches in column O starting from O2
.Offset(1, 0).Resize(UBound(SortedBranches) + 1, 1).Value = WorksheetFunction.Transpose(SortedBranches)
' Write the headers for products (same as branch names)
.Offset(0, 1).Resize(1, UBound(SortedBranches) + 1).Value = SortedBranches
' Write the products for each branch, sorted alphabetically
For Ta = 0 To UBound(SortedBranches)
M = Split(Dic1.Item(SortedBranches(Ta)), "_") ' Split products by "_"
SortedProducts = SortArray(M) ' Sort the products alphabetically
' Write the sorted products below each branch
If UBound(SortedProducts) >= 0 Then
.Offset(1, Ta + 1).Resize(UBound(SortedProducts) + 1, 1).Value = WorksheetFunction.Transpose(SortedProducts)
End If
Next Ta
End With
Application.ScreenUpdating = True
End Sub
' Function to sort an array alphabetically
Function SortArray(arr As Variant) As Variant
Dim i As Long, j As Long
Dim temp As Variant
' Bubble sort algorithm for sorting the array
For i = LBound(arr) To UBound(arr)
For j = i + 1 To UBound(arr)
If arr(i) > arr(j) Then
' Swap the elements
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
End If
Next j
Next i
SortArray = arr
End Function
any suggestions
Thanks in Advance
Subash D