This VBA works fine but I need Values to be side by side for same GSTIN with duplicate invoice nos. I have attached the excel and the VBA where it shows result as 12+18+28 then sum of all those taxable values of 12+18+28 and then sum of all taxes = 12+18+28 values. Instead of adding whole I need in transposed manner instead of ROWS I need in columns. for this VBA code.
VBA Code:
Option Explicit
Sub add()
Dim lr&, k&, j&, id As String, item As String, cell As Range, s, key, arr(), ws As Worksheet
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In Sheets
If ws.Name = "PORTAL" Then ws.Delete ' delete previous version of sheet PORTAL
Next
Application.DisplayAlerts = True
Worksheets("2B").Activate
lr = Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In Range("A7:A" & lr)
id = cell & "|" & cell.Offset(0, 1) & "|" & cell.Offset(0, 2) ' column A&B&C combination
item = cell.Offset(0, 4) & "|" & cell.Offset(0, 8) & "|" & cell.Offset(0, 9) & "|" & cell.Offset(0, 10) _
& "|" & cell.Offset(0, 11) & "|" & cell.Offset(0, 12) & "|" & cell.Offset(0, 13)
If Not dic.exists(id) Then
dic.add id, item
Else
s = Split(dic(id), "|")
dic(id) = s(0) & "|" & s(1) & "+" & cell.Offset(0, 8) & "|" & _
s(2) + cell.Offset(0, 9) & "|" & _
s(3) + cell.Offset(0, 10) & "|" & _
s(4) + cell.Offset(0, 11) & "|" & _
s(5) + cell.Offset(0, 12) & "|" & _
s(6) + cell.Offset(0, 13)
End If
Next
Sheets.add after:=ActiveSheet
ActiveSheet.Name = "PORTAL"
Worksheets("2B").Range("A1:V6").Copy Range("A1")
ReDim arr(1 To dic.Count, 1 To 22)
For Each key In dic.keys
k = k + 1
For j = 1 To 22
Select Case j
Case 1, 2, 3
arr(k, j) = Split(key, "|")(j - 1) & IIf(j = 3, "-Total", "")
Case 5
arr(k, j) = Split(dic(key), "|")(0)
Case 9, 10, 11, 12, 13
arr(k, j) = Split(dic(key), "|")(j - 8)
End Select
Next
Next
With Range("A7").Resize(dic.Count, 22)
.Value = arr
.EntireColumn.AutoFit
.Columns(9).HorizontalAlignment = xlCenter
End With
Range("J7:M" & dic.Count + 6).NumberFormat = "#,##0.00"
Application.ScreenUpdating = True
End Sub
Last edited by a moderator: