PDA

View Full Version : Sum up the amount for unique records from multiple tabs



Beatrix
06-09-2017, 05:01 AM
Hi All

I am working on a spreadsheet with multiple tabs. There are 12 individual worksheets which displays data for the period from April 16 to March 17. Each worksheet has the same structure but different number of columns. The column numbers I need to use is from Column number 3 to Column 11. I need to sum up the amounts of unique records based on 3 unique ID in column 3, column 6 and column 9 in each worksheet and at the end need to create a master tab which lists the total amount for each unique record details.

I attached a test sample file which displays 12 months data and the end result Master tab.

I was wondering if anyone could help me with this please?

Cheers
B.

SamT
06-09-2017, 05:20 AM
I don't know :dunno if this fits your situation, but a while back I worked on a project with many identical categories spread over many sheets (CostSheets array.) This allowed me to use formulas in the Categories summary sheet


Dim CostSheets As Variant

Private Sub Initialize_CostSheets()
CostSheets = Array("Common_Area", "Parking", "Direct Building", "Sitework", _
"Rec-Leasing", "Retail", "General Conditions")

End Sub


Public Function SumIfAllSheets(MatchRange As String, _
Criteria As Range, _
SumRange As String) _
As Double

Dim i As Long
Dim Temp As Double
Dim WSF As Object

Temp = 0

On Error Resume Next
If CostSheets(0) = "" Then
Initialize_CostSheets
End If
On Error GoTo 0

Set WSF = Application.WorksheetFunction

For i = LBound(CostSheets) To UBound(CostSheets)
With Sheets(CostSheets(i))
Temp = Temp + WSF.SumIf(.Range(MatchRange), Criteria, Range(SumRange))
End With
Next i

SumIfAllSheets = Temp

End Function

mdmackillop
06-09-2017, 05:32 AM
Are the values in columns 4,5,7,8,10 the same for each combination? If not, what goes into the Master?

mdmackillop
06-09-2017, 06:20 AM
Option Explicit


Sub test()
Dim sh As Worksheet
Dim Dic
Dim i
Dim x As String, y As Single
Dim k


Set Dic = CreateObject("Scripting.Dictionary")
For Each sh In Worksheets
With sh
If .Name <> "Master" Then
For i = 2 To LR(sh, 1)
x = .Cells(i, 3) & "-" & .Cells(i, 6) & "-" & .Cells(i, 9)
y = .Cells(i, 11)
If Dic.exists(x) Then
Dic(x) = CStr(Dic(x) + y)
Else
Dic.Add x, CStr(y)
End If
Next i
End If
End With
Next sh
Set sh = Sheets("Master")
i = 1
For Each k In Dic.Keys
i = i + 1
Cells(i, 1) = Split(k, "-")(0)
Cells(i, 4) = Split(k, "-")(1)
Cells(i, 7) = Split(k, "-")(2)
Cells(i, 9) = Dic(k)
Next
Range("A2:G" & i).NumberFormat = "0000"
End Sub




Function LR(sh, col) As Long
LR = sh.Cells(Rows.Count, col).End(xlUp).Row
End Function

Beatrix
06-09-2017, 08:07 AM
Hi mdmackillop

That's working great!! Thanks very much for your time and help. I'll practice on this script to be able to do next similar task. I understand your script but I still can't put things together by myself. Thank you so much!! Much much appreciated.

Cheers
B.

Beatrix
06-09-2017, 08:15 AM
Hi SamT

Thank you so much for your script, I am not there yet regarding my VBA skills, I will break it down line by line and will do practice after I understand how it works. Many thanks tho. I am learning a lot from VBA express with VBA GURUs' support:cloud9:

Cheers
B.

Beatrix
06-11-2017, 03:53 PM
Hi mdmackillop

I am having a run time error "13" Type mismatch when I adjust the script based on the original file. When I debug it highlights

y = .Cells(i, 11) I am sure the data format is exactly the same with the sample test file. I really don't know what's causing to this problem :(



Sub test()
Dim sh As Worksheet
Dim Dic
Dim i
Dim x As String, y As Single
Dim k


Set Dic = CreateObject("Scripting.Dictionary")
For Each sh In Worksheets
With sh
If .Name <> "Master" Then
For i = 2 To LR(sh, 1)
x = .Cells(i, 3) & "-" & .Cells(i, 4) & "-" & .Cells(i, 5) & "-" & .Cells(i, 6) & "-" & .Cells(i, 7) & "-" & .Cells(i, 8) & "-" & .Cells(i, 9) & "-" & .Cells(i, 10)
y = .Cells(i, 11)
If Dic.exists(x) Then
Dic(x) = CStr(Dic(x) + y)
Else
Dic.Add x, CStr(y)
End If
Next i
End If
End With
Next sh
Set sh = Sheets("Master")
i = 1
For Each k In Dic.Keys
i = i + 1
Cells(i, 1) = Split(k, "-")(0)
Cells(i, 2) = Split(k, "-")(1)
Cells(i, 3) = Split(k, "-")(2)
Cells(i, 4) = Split(k, "-")(3)
Cells(i, 5) = Split(k, "-")(4)
Cells(i, 6) = Split(k, "-")(5)
Cells(i, 7) = Split(k, "-")(6)
Cells(i, 8) = Split(k, "-")(7)
Cells(i, 9) = Dic(k)
Next
Range("A2:G" & i).NumberFormat = "0000"

End Sub




Function LR(sh, col) As Long
LR = sh.Cells(Rows.Count, col).End(xlUp).Row
End Function

mdmackillop
06-12-2017, 01:48 AM
The final lines should be changed as follows to ensure that results are written to Master.

Set sh = Sheets("Master")
With sh
i = 1
For Each k In Dic.Keys
i = i + 1
.Cells(i, 1) = Split(k, "-")(0)
.Cells(i, 2) = Split(k, "-")(1)
.Cells(i, 3) = Split(k, "-")(2)
.Cells(i, 4) = Split(k, "-")(3)
.Cells(i, 5) = Split(k, "-")(4)
.Cells(i, 6) = Split(k, "-")(5)
.Cells(i, 7) = Split(k, "-")(6)
.Cells(i, 8) = Split(k, "-")(7)
.Cells(i, 9) = Dic(k)
Next
.Range("A2:G" & i).NumberFormat = "0000"
End With

If you still have the error, check the sheet relevant to that line when the code fails.

Beatrix
06-13-2017, 01:43 AM
Many thanks for your response mdmackillop

I tested each worksheet to find the problem and the problem was blank cells in Amount column. I've learned my lesson, next time I'll check the blank cells first in any data sets.

Cheers
B.

mdmackillop
06-13-2017, 06:14 AM
If blanks are a possibility then the code can be amended to cope. If your require assistance please post a "problem" workbook.

snb
06-13-2017, 06:53 AM
Sub M_snb()
With CreateObject("Scripting.Dictionary")
For Each sh In Worksheets
If sh.Name <> "Master" Then
sn = sh.Cells(1).CurrentRegion

For j = 2 To UBound(sn)
.Item(sn(j, 3) & "_" & sn(j, 6) & "_" & sn(j, 9)) = .Item(sn(j, 3) & "_" & sn(j, 6) & "_" & sn(j, 9)) + sn(j, 11)
Next
End If
Next
y = .Count
Application.DisplayAlerts = False
Sheets("Master").Cells(2, 14).Resize(.Count, 4) = Application.Transpose(Array(.keys, .keys, .keys, .items))
End With

With Sheets("Master")
.Cells(2, 14).Resize(y).TextToColumns , , , , 0, 0, 0, 0, -1, "_"
.Cells(2, 1).Resize(y) = .Cells(2, 14).Resize(y).Value
.Cells(2, 4).Resize(y) = .Cells(2, 15).Resize(y).Value
.Cells(2, 7).Resize(y) = .Cells(2, 16).Resize(y).Value
.Cells(2, 9).Resize(y) = .Cells(2, 17).Resize(y).Value
End With
End Sub