How to Sum of all Sheets that meet the criteria From Columns "D"? VBA please help

punnipah

Board Regular
Joined
Nov 3, 2021
Messages
134
Office Version
  1. 2019
Platform
  1. Windows
Hi

I want the sum of all Sheets that meet the criteria From Columns "D" and then Copy Total to Windows("ReportSMS&IVR" & ".xlsx")
Range("H10").PasteSpecial


This my Code not working

please help me


Global Variables
Dim g_dirMainPath As String
Dim g_dirInputPath As String
Dim g_dirOutputPath As String
Dim g_dirTemplatePath As String
Dim g_wbMacro As Workbook
Dim g_wbSaleVolume As Workbook
Dim g_wbPayment As Workbook
Dim g_wbTemplate As Workbook
Dim g_wbfdd As Workbook
Dim i As Long, p As String
Dim c As Range, lastRow As Long
Dim FolderPath As String
Dim FileName As String
Dim FileSystem As Object
Dim Folder As Object
Dim File As Object
Dim ws As Worksheet
Dim totalSum As Double
Dim LastCol As Long


Sub initial()
Set g_wbMacro = ThisWorkbook
g_dirMainPath = g_wbMacro.path & "\"
g_dirInputPath = g_dirMainPath & "Input\"
g_dirOutputPath = g_dirMainPath & "Output\"
g_dirTemplatePath = g_dirMainPath & "Template\"

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.EnableLivePreview = False
Application.GenerateTableRefs = xlGenerateTableRefStruct
End Sub

Sub finished()
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.EnableLivePreview = True
Application.GenerateTableRefs = xlGenerateTableRefStruct
End Sub

Sub Main()
Call initial
' ==============================================================================================================================================
Dim newDate: newDate = Format(DateAdd("M", -1, Now), "MMMM")
On Error Resume Next
Call wbSetOpen(g_wbTemplate, g_dirTemplatePath, "*Template*.xls*")
On Error GoTo 0

Call wbSaveReplace(g_wbTemplate, g_dirOutputPath + "ReportSMS&IVR", False)

On Error Resume Next
Sheets("Device").Select
On Error GoTo 0


FolderPath = "C:\Users\ABC\Desktop\ReportSMS&IVR\Input\"


FileName = Dir(FolderPath & "*.xls")


Do While FileName <> ""
If InStr(FileName, "Dev") > 0 And InStr(FileName, "BC11") > 1 Then
filePath = FolderPath & FileName


Workbooks.Open filePath


With ActiveWorkbook.Sheets("Page 1")
lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
End With


totalSum = totalSum + Range("D" & lastRow).value

ActiveSheet.Range("D" & lastRow).Copy



Windows("ReportSMS&IVR" & ".xlsx").Activate
Range("H10").PasteSpecial



End If


FileName = Dir
Loop

End sub
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Hi, It would be good if you can provide more sample data through mini sheet via XLBB with expected result for better understanding

Want to help your helpers by posting a small, copyable, screen shot directly in your post? XL2BB Instructions & Download (latest January 2021 v 2.0 )


You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

sum of all Sheets that meet the criteria From Columns "D" -What kind of criteria in Column D, How can we define it?
 
Upvote 0
Hi, It would be good if you can provide more sample data through mini sheet via XLBB with expected result for better understanding

Want to help your helpers by posting a small, copyable, screen shot directly in your post? XL2BB Instructions & Download (latest January 2021 v 2.0 )


You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

sum of all Sheets that meet the criteria From Columns "D" -What kind of criteria in Column D, How can we define it?

Sheet 1
 
Upvote 0
Hi, It would be good if you can provide more sample data through mini sheet via XLBB with expected result for better understanding

Want to help your helpers by posting a small, copyable, screen shot directly in your post? XL2BB Instructions & Download (latest January 2021 v 2.0 )


You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

sum of all Sheets that meet the criteria From Columns "D" -What kind of criteria in Column D, How can we define it?

Sheet 1

Dev_SMS1 ก่อนDue3_BC11.1.xls
ABCDEFGHIJKLM
1 Receipt Date From : [22/04/2023] To [26/04/2023]
2
3
4Grand Total20,64218,167,365.22020,3905,91328.65############28.43
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Page 1




Sheet 2

Dev_SMS1 ก่อนDue3_BC11.xls
ABCDEFGHIJKL
1 Receipt Date From : [18/04/2023] To [22/04/2023]
2Grand Total500######010,3672,40622.92############22.43
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Page 1



Sheet Output
i want to Sum Columns "D" 2 sheet or meet more than 2 conditions

Windows("ReportSMS&IVR" & ".xlsx").Activate
Range("H10").PasteSpecial
 
Upvote 0
Sheet 1

Dev_SMS1 ก่อนDue3_BC11.1.xls
ABCDEFGHIJKLM
1 Receipt Date From : [22/04/2023] To [26/04/2023]
2
3
4Grand Total20,64218,167,365.22020,3905,91328.65############28.43
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Page 1




Sheet 2

Dev_SMS1 ก่อนDue3_BC11.xls
ABCDEFGHIJKL
1 Receipt Date From : [18/04/2023] To [22/04/2023]
2Grand Total500######010,3672,40622.92############22.43
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Page 1



Sheet Output
i want to Sum Columns "D" 2 sheet or meet more than 2 conditions

Windows("ReportSMS&IVR" & ".xlsx").Activate
Range("H10").PasteSpecial

Go through each sheets, Total all sheets in column D (Based in grand total) ? If sheets got 10 then total all 10? Or only several sheets with condition?

If only several sheets, What's the condition?

then put in "ReportSMS&IVR" & ".xlsx" H10
 
Upvote 0
Go through each sheets, Total all sheets in column D (Based in grand total) ? If sheets got 10 then total all 10? Or only several sheets with condition?

If only several sheets, What's the condition?

then put in "ReportSMS&IVR" & ".xlsx" H10
Go through each sheets, Total all sheets in column D (Based in grand total) ?
Yes

If sheets got 10 then total all 10? Or only several sheets with condition?
- Total 10 sheets
-several sheets with condition : Enter the value 1 sheet
 
Upvote 0
Go through each sheets, Total all sheets in column D (Based in grand total) ?
Yes

If sheets got 10 then total all 10? Or only several sheets with condition?
- Total 10 sheets
-several sheets with condition : Enter the value 1 sheet

Hi, You can create a module and put the below code into the ReportSMS&IVR Workbook. After that, you may run the code and select the workbooks (multiple selection is possible).

It will loop through all the workbook sheets, find the grand total, and then sum ttl variable. After looping through all of them, it will paste the value into H10 (Report Sheets).

VBA Code:
Option Compare Text
Sub test()
Dim filetoopen As Variant
Dim ttl As Long

'Find Workbook that want to count the grand total, Can multiple select
filetoopen = Application.GetOpenFilename(Filefilter:="Excel Files (*.xlsx), *.xlsx", Title:="Select workbook to import", MultiSelect:=True)

If IsArray(filetoopen) Then
    For FileCNT = 1 To UBound(filetoopen) 'Loop through workbook and open the workbooks
             Set openbook = Workbooks.Open(Filename:=filetoopen(FileCNT))
         
        For I = 1 To openbook.Worksheets.Count
              With openbook.Sheets(I)
                    Set f = .Range("a1:a10000").Find("Grand Total", LookIn:=xlValues) 'Find Grand Total Column
                    If Not f Is Nothing Then
                          ttl = f.Offset(0, 3).Value + ttl 'Grand Total Column A then offset 3 to column D
                    End If
              End With
        Next I
    
        openbook.Close

    Next FileCNT
End If

ThisWorkbook.Sheets("Sheet1").[h10].Value = ttl

End Sub
 
Last edited:
Upvote 0
Hi, You can create a module and put the below code into the ReportSMS&IVR Workbook. After that, you may run the code and select the workbooks (multiple selection is possible).

It will loop through all the workbook sheets, find the grand total, and then sum ttl variable. After looping through all of them, it will paste the value into H10 (Report Sheets).

VBA Code:
Option Compare Text
On ERror Resume Next
Sub test()
Dim filetoopen As Variant
Dim ttl As Long

'Find Workbook that want to count the grand total, Can multiple select
filetoopen = Application.GetOpenFilename(Filefilter:="Excel Files (*.xlsx), *.xlsx", Title:="Select workbook to import", MultiSelect:=True)

If IsArray(filetoopen) Then
    For FileCNT = 1 To UBound(filetoopen) 'Loop through workbook and open the workbooks
             Set openbook = Workbooks.Open(Filename:=filetoopen(FileCNT))
         
        For I = 1 To openbook.Worksheets.Count
              With openbook.Sheets(I)
                    Set f = .Range("a1:a10000").Find("Grand Total", LookIn:=xlValues) 'Find Grand Total Column
                    If Not f Is Nothing Then
                          ttl = f.Offset(0, 3).Value + ttl 'Grand Total Column A then offset 3 to column D
                    End If
              End With
        Next I
    
        openbook.Close

    Next FileCNT
End If

ThisWorkbook.Sheets("Sheet1").[h10].Value = ttl

End Sub
i have FileName I don't want to select a new file.
Help me merge the resulting code, I will get the desired result.


Do While FileName <> ""
If InStr(FileName, "Dev") > 0 And InStr(FileName, "BC11") > 0 Then
filePath = FolderPath & FileName
 
Upvote 0
i have FileName I don't want to select a new file.
Help me merge the resulting code, I will get the desired result.


Do While FileName <> ""
If InStr(FileName, "Dev") > 0 And InStr(FileName, "BC11") > 0 Then
filePath = FolderPath & FileName

You may change filetoopen as your desire path

VBA Code:
Option Compare Text
Sub test()
Dim filetoopen As Variant
Dim ttl As Long
Application.ScreenUpdating = False
'Find Workbook that want to count the grand total, Can multiple select
'filetoopen = Application.GetOpenFilename(Filefilter:="Excel Files (*.xlsx), *.xlsx", Title:="Select workbook to import", MultiSelect:=True)

filetoopen = Dir("C:\Users\Admin\Desktop\ReportSMS&IVR\Input\") ' Change your desire path

While filetoopen <> ""
        Set openbook = Workbooks.Open(Filename:=filetoopen)

        For I = 1 To openbook.Worksheets.Count
              With openbook.Sheets(I)
                    Set f = .Range("a1:a10000").Find("Grand Total", LookIn:=xlValues) 'Find Grand Total Column
                    If Not f Is Nothing Then
                          ttl = f.Offset(0, 3).Value + ttl 'Grand Total Column A then offset 3 to column D
                    End If
              End With
        Next I
 
        openbook.Close
        filetoopen = Dir
 
Wend

ThisWorkbook.Sheets("Sheet1").[h10].Value = ttl
Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Solution
You may change filetoopen as your desire path

VBA Code:
Option Compare Text
Sub test()
Dim filetoopen As Variant
Dim ttl As Long
Application.ScreenUpdating = False
'Find Workbook that want to count the grand total, Can multiple select
'filetoopen = Application.GetOpenFilename(Filefilter:="Excel Files (*.xlsx), *.xlsx", Title:="Select workbook to import", MultiSelect:=True)

filetoopen = Dir("C:\Users\Admin\Desktop\ReportSMS&IVR\Input\") ' Change your desire path

While filetoopen <> ""
        Set openbook = Workbooks.Open(Filename:=filetoopen)

        For I = 1 To openbook.Worksheets.Count
              With openbook.Sheets(I)
                    Set f = .Range("a1:a10000").Find("Grand Total", LookIn:=xlValues) 'Find Grand Total Column
                    If Not f Is Nothing Then
                          ttl = f.Offset(0, 3).Value + ttl 'Grand Total Column A then offset 3 to column D
                    End If
              End With
        Next I
 
        openbook.Close
        filetoopen = Dir
 
Wend

ThisWorkbook.Sheets("Sheet1").[h10].Value = ttl
Application.ScreenUpdating = True
End Sub
Thank you Very Much
 
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,219
Members
452,619
Latest member
Shiv1198

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top