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

P

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

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Sort by date Sort by votes
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 )

www.mrexcel.com

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...
www.mrexcel.com www.mrexcel.com

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
RudRud said:
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 )

www.mrexcel.com

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...
www.mrexcel.com www.mrexcel.com

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?
Click to expand...

Sheet 1
 
Upvote 0
RudRud said:
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 )

www.mrexcel.com

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...
www.mrexcel.com www.mrexcel.com

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?
Click to expand...

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
punnipah said:
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
Click to expand...

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
RudRud said:
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
Click to expand...
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
punnipah said:
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
Click to expand...

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
RudRud said:
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
Click to expand...
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
punnipah said:
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
Click to expand...

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
RudRud said:
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
Click to expand...
Thank you Very Much
 
Upvote 0
You must log in or register to reply here.

Similar threads

Artik
  • Question Question
VBA code to click Image in WebBrowser control.
Replies
4
Views
172
Artik
Artik
T
  • Solved
Open all files in a folder and run macro
Replies
3
Views
610
Trebor76
T
F
  • Solved
VBA to open all files in a folder, put the file's name in a cell and copy it to another opened workbook
Replies
5
Views
1K
feni1388
F
B
  • Question Question
VBA exports worksheet from XLSM to XLXS matching all source properties doesn't keep print area
Replies
0
Views
81
brentcole
B
H
  • Question Question
VBA split file based and send splitted file in separate emails
Replies
0
Views
683
harmless92
H

Forum statistics

Threads
1,223,246
Messages
6,170,999
Members
452,373
Latest member
TimReeks

Share this page

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