Selected Answer
The code below will not enter the formulas you ask for but it will draw the totals. The reason is that your entire worksheet has no formulas. Therefore I think you need the numbers. Should I be mistaken the change would be almost negligible but the result would take a little longer to appear because formulas must be written to the sheet one by one whereas numbers are written wholesale in the code below.
Private Sub AddTotals(Ws As Worksheet)
' 227
Dim Data As Variant ' all of CurrentRegion
Dim Totals As Variant
Dim TotalClm As Long ' last column on the right
Dim R As Long ' loop counter: Rows
Dim Rstart As Long ' first row of subtotal calculation
Dim Rend As Long ' last row of subtotal calculation
Dim i As Long ' loop counter: index of Data
With Ws
' last used column in row 2
TotalClm = .Cells(2, .Columns.Count).End(xlToLeft).Column
Data = .Range(.Cells(1, 1), .Cells(.Rows.Count, TotalClm).End(xlUp)).Value
ReDim Totals(1 To UBound(Data))
Totals(2) = "QTY"
Rstart = 3 ' start in row 3
Rend = Rstart
For R = Rstart To UBound(Data)
If InStr(1, Data(R, 2), "total", vbTextCompare) Then
For i = Rstart To (Rend - 1)
Totals(R) = Totals(R) + Totals(i)
Next i
Rstart = R + 1
Rend = R
Else
Totals(R) = Data(R, TotalClm - 3) + Data(R, TotalClm - 2) - Data(R, TotalClm - 1)
End If
Rend = Rend + 1
Next R
.Cells(1, TotalClm).Resize(UBound(Totals)).Value = Application.Transpose(Totals)
End With
End Sub
The code loops through all rows of the first sheet in your Output Mod wortkbook and calculates the numbers in column J, differently depending upon whether or not the word "TOTAL" appears in column B. It then writes the calculated totals to column J, over-writing whatever was there before.
"Column J" is always the last used column on the right (as measured in row 2). So, as you add more columns, previous ones aren't touched.
My code is in a separate procedure which you can paste at the bottom of your Module1 already existing in the Output Mod workbook. You can use this sub to call the procedure by itself for testing or even use. Remove the word "Private" from the declaration line if you want to cal the sub from the workbook UI.
Private Sub Test_AddTotals()
AddTotals Sheets(1)
End Sub
Of course, your objective is to have the totals added when the 3 columns are. That's a little bit more tricky. I didn't want to run your entire code. So I make a guess. Add the one line needed at the location in your existing procedure indicated by bold type below.
Private Sub OutPut(wsName As String, x, dic As Object)
Dim i As Long, ii As Long, iii As Long, n As Long
Dim a, b, e, s, txt As String, temp, R As Range
Application.ScreenUpdating = False
With Sheets(1).Cells(1).CurrentRegion
.Columns(.Columns.Count - 2).Resize(, 3).AutoFill _
Destination:=.Columns(.Columns.Count - 2).Resize(, 6)
With .Cells(1).CurrentRegion.Offset(2).Resize(.Rows.Count - 2)
.Columns(.Columns.Count - 2).Resize(, 3).ClearContents
a = .Value: .ClearContents: .Borders.LineStyle = xlNone
.Font.Bold = False
ReDim b(1 To Rows.Count, 1 To UBound(a, 2))
.Interior.ColorIndex = xlNone
AddTotals Sheets(1)
For i = 1 To UBound(a, 1)
The point is that "Calumn J" must already exist when the procedure is called, and the data for it, too. And it must not be called in a loop. If the location I suggest is too early, place a break point in the code, run your procedure and insert my procedure call at the correct location.
By the way, the spelling errors in your worksheet headers are hard programmed in your procedure GetData. If you change the spelling in the code you can also change it in the worksheets.
rs.Open "Select `CATOGERY`, `BRAND`, `TYPE`, `MONAFACTURE`, Sum(`Purchase`), Sum(`Sales`) From `PR$` " & _
"In '" & ThisWorkbook.Path & "\" & fn & "' 'Excel 12.0;''HDR:=Yes;''' Group By `CATOGERY`, `BRAND`, `TYPE`, `MONAFACTURE`;", cn, 3
Note that you can use Edit > Find or Edit > Replace in the VB Editor to find all occurrencues of, for instance, "MONAFACTURE" and substitute the word for something more English.