• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Particular Range each column wise sum & match with Total in last row

A

Abhijeet

Active Member
I need each file & each sheet Particular Range each column Sum & match with last row total & if not match then give that file & Sheet name.

If Particular row Headers not match then give that file & sheet name in different sheet

please tell me how to do this
 
Hi

I tried but stuck in how to match total mention in Row 21 in each column if not match then give file & sheet name please tell me how to do this
 

Attachments

  • Sum in Range Column Wise.xlsm
    14.1 KB · Views: 7
Hi !

To "match", use Application.Match,
see MATCH worksheet function in Excel help and samples within threads …

Other way is to use Find method …
​
 
Hi Marc L

I use this but how to loop this i can not loop this Application.Match so pls tell me how loop this
 
Hi

I tried to do this but this pull only active sheet i need all sheets from all files
Please tell me what changes need to do in this macro
Code: 
Sub SumCheck()

Dim MR As Long, MC As Long, MR1 As Long

With ActiveSheet
MR = .Range("a" & Rows.Count).End(xlUp).Row
MR1 = .Range("b" & Rows.Count).End(xlUp).Row
MC = .Cells(7, .Columns.Count).End(xlToLeft).Column
End With

ActiveSheet.Cells(MR + 4, 1) = WorksheetFunction.Sum(Range(Cells(MR1, 2), Cells(MR1, MC)))
ActiveSheet.Cells(MR + 4, 2) = WorksheetFunction.Sum(Range(Cells(8, 2), Cells(MR, MC)))

If ActiveSheet.Cells(MR + 4, 1) <> ActiveSheet.Cells(MR + 4, 2) Then
ActiveSheet.Range("xfd1") = "False"
Else: ActiveSheet.Range("xfd1") = "True"
End If

End Sub



Sub Sum_Check_All()
   
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceRcount As Long, FNum As Long, myrow As Long, myrow1 As Long
    Dim mybook As Workbook, BaseWks As Workbook, Sh As Worksheet
    Dim sourceRange As Range, destrange As Range, Rng As Range
    Dim rnum As Long, CalcMode As Long

    ' Change this to the path\folder location of your files.
    MyPath = Worksheets("sheet2").Range("A2").Value

    ' Add a slash at the end of the path if needed.
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If

    ' If there are no Excel files in the folder, exit.
    FilesInPath = Dir(MyPath & "*.xlsx*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    ' Fill the myFiles array with the list of Excel files
    ' in the search folder.
    FNum = 0
    Do While FilesInPath <> ""
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        MyFiles(FNum) = FilesInPath
        FilesInPath = Dir()
    Loop

    ' Set various application properties.
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Add a new workbook with one sheet.
    Set BaseWks = ThisWorkbook
   

    ' Loop through all files in the myFiles array.
    If FNum > 0 Then
        For FNum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
            For Each Sh In mybook.Worksheets
            myrow1 = BaseWks.Sheets("Sum Err").Range("a" & Rows.Count).End(xlUp).Row
           
            SumCheck
            If Sh.Range("xfd1") = "False" Then
            BaseWks.Sheets("Sum Err").Cells(myrow1 + 1, 1) = mybook.Name
            BaseWks.Sheets("Sum Err").Cells(myrow1 + 1, 2) = Sh.Name
            End If
           
           
            Next
            'mybook.Save
            Application.DisplayAlerts = False
            mybook.Close SaveChanges:=False
            Application.DisplayAlerts = True
            On Error GoTo 0


        Next FNum
       
        On Error Resume Next
        BaseWks.Save
        If Err.Number = 1004 Then
        MsgBox "Please Save This New Workbook With New Name :-)", vbInformation
       
        End If
       
End If
   
ExitTheSub:
    ' Restore the application properties.
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
MsgBox "Thanks for using :-)"

End Sub
 
A sample to display worksheets names of current workbook
in VBE Immediate window (CTRL + G) :​
Code: 
Sub Demo()
         Dim Ws As Worksheet
    For Each Ws In ActiveWorkbook.Worksheets
        Debug.Print Ws.Name
    Next
End Sub
Within the loop, Ws object variable is a worksheet of current workbook …
​
 
Yes i know this but current code mention active sheet so what need to change
Code: 
With ActiveSheet
MR = .Range("a" & Rows.Count).End(xlUp).Row
MR1 = .Range("b" & Rows.Count).End(xlUp).Row
MC = .Cells(7, .Columns.Count).End(xlToLeft).Column
End With

ActiveSheet.Cells(MR + 4, 1) = WorksheetFunction.Sum(Range(Cells(MR1, 2), Cells(MR1, MC)))
ActiveSheet.Cells(MR + 4, 2) = WorksheetFunction.Sum(Range(Cells(8, 2), Cells(MR, MC)))

If ActiveSheet.Cells(MR + 4, 1) <> ActiveSheet.Cells(MR + 4, 2) Then
ActiveSheet.Range("xfd1") = "False"
Else: ActiveSheet.Range("xfd1") = "True"
End If
 

If you already know, why this thread ?‼

Just replace any worksheet reference by the variable object used
within For Each loop as you must see in my previous post …
​
 
Marc L

U are correct if i know then why i post this thread

I know this method ForEach Ws In ActiveWorkbook.Worksheets

but in current code i can not do this i use this method but not work

so please tell me what should be use for "ActiveSheet " mention in code part
 
Hi

I tried & do this but i do not know is this correct or not so pls tell me
Code: 
Sub SumCheck()

Dim MR As Long, MC As Long, MR1 As Long
Dim ws As Worksheet

For Each ws In Worksheets
With ws
MR = .Range("a" & Rows.Count).End(xlUp).Row
MR1 = .Range("b" & Rows.Count).End(xlUp).Row
MC = .Cells(7, .Columns.Count).End(xlToLeft).Column
End With

ws.Cells(MR + 4, 1) = WorksheetFunction.Sum(Range(Cells(MR1, 2), Cells(MR1, MC)))
ws.Cells(MR + 4, 2) = WorksheetFunction.Sum(Range(Cells(8, 2), Cells(MR, MC)))

If ws.Cells(MR + 4, 1) <> ws.Cells(MR + 4, 2) Then
ws.Range("xfd1") = "False"
Else: ws.Range("xfd1") = "True"
End If
Next ws


End Sub



Sub Sum_Check_All()
   
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceRcount As Long, FNum As Long, myrow As Long, myrow1 As Long
    Dim mybook As Workbook, BaseWks As Workbook, sh As Worksheet
    Dim sourceRange As Range, destrange As Range, Rng As Range
    Dim rnum As Long, CalcMode As Long

    ' Change this to the path\folder location of your files.
    MyPath = Worksheets("sheet2").Range("A2").Value

    ' Add a slash at the end of the path if needed.
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If

    ' If there are no Excel files in the folder, exit.
    FilesInPath = Dir(MyPath & "*.xlsx*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    ' Fill the myFiles array with the list of Excel files
    ' in the search folder.
    FNum = 0
    Do While FilesInPath <> ""
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        MyFiles(FNum) = FilesInPath
        FilesInPath = Dir()
    Loop

    ' Set various application properties.
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Add a new workbook with one sheet.
    Set BaseWks = ThisWorkbook
   

    ' Loop through all files in the myFiles array.
    If FNum > 0 Then
        For FNum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
            For Each sh In mybook.Worksheets
            myrow1 = BaseWks.Sheets("Sum Err").Range("a" & Rows.Count).End(xlUp).Row
           
            SumCheck
            If sh.Range("xfd1") = "False" Then
            BaseWks.Sheets("Sum Err").Cells(myrow1 + 1, 1) = mybook.Name
            BaseWks.Sheets("Sum Err").Cells(myrow1 + 1, 2) = sh.Name
            End If
           
           
            Next
            'mybook.Save
            Application.DisplayAlerts = False
            mybook.Close SaveChanges:=False
            Application.DisplayAlerts = True
            On Error GoTo 0


        Next FNum
       
        On Error Resume Next
        BaseWks.Save
        If Err.Number = 1004 Then
        MsgBox "Please Save This New Workbook With New Name :-)", vbInformation
       
        End If
       
End If
   
ExitTheSub:
    ' Restore the application properties.
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
MsgBox "Thanks for using :-)"

End Sub
 

From original code, WorksheetFunction.Sum( ) seems odd 'cause
there is no worksheet reference before Cells properties !

Without any worksheet reference, Cells alone means ActiveWorksheet.Cells if code located in a standard module …

So first check results of Sum !
​
 
i check with sum for each sheet calculate but problem is is more than 2 sheets then not give proper result because of sheet loop so can u please tell me how to sheet loop
Code: 
Sub SumCheck()

Dim MR As Long, MC As Long, MR1 As Long
Dim ws As Worksheet

For Each ws In Worksheets
If ws.UsedRange.Address = "$A$1" And Range("A1") = "" Then GoTo nextws
'If WorksheetFunction.CountA(Cells) = 0 Then GoTo nextws
With ws
MR = .Range("a" & Rows.Count).End(xlUp).Row
MR1 = .Range("b" & Rows.Count).End(xlUp).Row
MC = .Cells(7, .Columns.Count).End(xlToLeft).Column

End With

ws.Cells(MR + 4, 1) = WorksheetFunction.Sum(Range(Cells(MR1, 2), Cells(MR1, MC)))
ws.Cells(MR + 4, 2) = WorksheetFunction.Sum(Range(Cells(8, 2), Cells(MR, MC)))

If ws.Cells(MR + 4, 1) <> ws.Cells(MR + 4, 2) Then
ws.Range("xfd1") = "False"
Else: ws.Range("xfd1") = "True"
End If
nextws:    Next



End Sub



Sub Sum_Check_All()
   
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceRcount As Long, FNum As Long, myrow As Long, myrow1 As Long
    Dim mybook As Workbook, BaseWks As Workbook, sh As Worksheet
    Dim sourceRange As Range, destrange As Range, Rng As Range
    Dim rnum As Long, CalcMode As Long

    ' Change this to the path\folder location of your files.
    'MyPath = Worksheets("sheet2").Range("A2").Value
    Application.ScreenUpdating = False
'Put this macro in folder remove that folder all files
'myPath = Application.ThisWorkbook.Path & "\"
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    MyPath = .SelectedItems(1) & "\"
End With

    ' Add a slash at the end of the path if needed.
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If

    ' If there are no Excel files in the folder, exit.
    FilesInPath = Dir(MyPath & "*.xlsx*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    ' Fill the myFiles array with the list of Excel files
    ' in the search folder.
    FNum = 0
    Do While FilesInPath <> ""
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        MyFiles(FNum) = FilesInPath
        FilesInPath = Dir()
    Loop

    ' Set various application properties.
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Add a new workbook with one sheet.
    Set BaseWks = ThisWorkbook
   

    ' Loop through all files in the myFiles array.
    If FNum > 0 Then
        For FNum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
            For Each sh In mybook.Worksheets
            myrow1 = BaseWks.Sheets("Sum Err").Range("a" & Rows.Count).End(xlUp).Row
           
            SumCheck
            If sh.Range("xfd1") = "False" Then
            BaseWks.Sheets("Sum Err").Cells(myrow1 + 1, 1) = mybook.Name
            BaseWks.Sheets("Sum Err").Cells(myrow1 + 1, 2) = sh.Name
            End If
           
           
            Next
            'mybook.Save
            Application.DisplayAlerts = False
            mybook.Close SaveChanges:=False
            Application.DisplayAlerts = True
            On Error GoTo 0


        Next FNum
       
        On Error Resume Next
        BaseWks.Save
        If Err.Number = 1004 Then
        MsgBox "Please Save This New Workbook With New Name :-)", vbInformation
       
        End If
       
End If
   
ExitTheSub:
    ' Restore the application properties.
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
MsgBox "Thanks for using :-)"

End Sub
 

Attachments

  • Sum Match Macro Ver1.3.xlsm
    22.5 KB · Views: 2
As I yet wrote, result is wrong 'cause it seems you forgot in Sum calculation
from which workbook and which worksheet are the Cells properties !

So with WorksheetFunction.Sum(Range(Cells(8, 2), Cells(MR, MC))
Cells alone just means cells from active worksheet !

Just check what returns .Address(External:=True) on this Range
to see if it's good or not …
If not, just add correct worksheet before Cells properties !

TBTO rule : respect Excel object model !
An easy model : Application / Workbook / Worksheet / Range or Cells …
​
 
This Part of code is work correct but problem is 2 times loop each sheet that is problem i am stuck to solve this issue so pls tell me
Code: 
ws.Cells(MR + 4, 1) = WorksheetFunction.Sum(Range(Cells(MR1, 2), Cells(MR1, MC)))
ws.Cells(MR + 4, 2) = WorksheetFunction.Sum(Range(Cells(8, 2), Cells(MR, MC)))
 
Marc L said:
As I yet wrote, result is wrong 'cause it seems you forgot in Sum calculation
from which workbook and which worksheet are the Cells properties !

So with WorksheetFunction.Sum(Range(Cells(8, 2), Cells(MR, MC))
Cells alone just means cells from active worksheet !

Just check what returns .Address(External:=True) on this Range
to see if it's good or not …
If not, just add correct worksheet before Cells properties !

TBTO rule : respect Excel object model !
An easy model : Application / Workbook / Worksheet / Range or Cells …
​
Click to expand...
I know what u are telling me but i use ws.Select so each loop every worksheet is select
 
Better is to precise object than to select any !​
Abhijeet said:
but problem is 2 times loop each sheet
Click to expand...
I do not understand 'cause a loop can't do 2 times as it's just a loop !

Progress in code via step by step mode via F8 key and check values
in Locals window as well in result worksheet …
​
 
Progress in code via step by step mode via F8 key result i observe i told 1st loop for sheets
Code: 
For Each ws In Worksheets
If ws.UsedRange.Address = "$A$1" And Range("A1") = "" Then GoTo nextws
'If WorksheetFunction.CountA(Cells) = 0 Then GoTo nextws
With ws
MR = .Range("a" & Rows.Count).End(xlUp).Row
MR1 = .Range("b" & Rows.Count).End(xlUp).Row
MC = .Cells(7, .Columns.Count).End(xlToLeft).Column

End With

ws.Cells(MR + 4, 1) = WorksheetFunction.Sum(Range(Cells(MR1, 2), Cells(MR1, MC)))
ws.Cells(MR + 4, 2) = WorksheetFunction.Sum(Range(Cells(8, 2), Cells(MR, MC)))

If ws.Cells(MR + 4, 1) <> ws.Cells(MR + 4, 2) Then
ws.Range("xfd1") = "False"
Else: ws.Range("xfd1") = "True"
End If
nextws:    Next
 
then 2nd loop is this part
Code: 
For Each sh In mybook.Worksheets
            myrow1 = BaseWks.Sheets("Sum Err").Range("a" & Rows.Count).End(xlUp).Row
           
            SumCheck
            If sh.Range("xfd1") = "False" Then
            BaseWks.Sheets("Sum Err").Cells(myrow1 + 1, 1) = mybook.Name
            BaseWks.Sheets("Sum Err").Cells(myrow1 + 1, 2) = sh.Name
            End If
           
           
            Next
 
Can u please tell me how to loop sheets in this code
Code: 
Sub SumCheck()

Dim MR As Long, MC As Long, MR1 As Long
Dim ws As Worksheet

For Each ws In Worksheets
If ws.UsedRange.Address = "$A$1" And Range("A1") = "" Then GoTo nextws
'If WorksheetFunction.CountA(Cells) = 0 Then GoTo nextws
With ws
MR = .Range("a" & Rows.Count).End(xlUp).Row
MR1 = .Range("b" & Rows.Count).End(xlUp).Row
MC = .Cells(7, .Columns.Count).End(xlToLeft).Column

End With

ws.Cells(MR + 4, 1) = WorksheetFunction.Sum(Range(Cells(MR1, 2), Cells(MR1, MC)))
ws.Cells(MR + 4, 2) = WorksheetFunction.Sum(Range(Cells(8, 2), Cells(MR, MC)))

If ws.Cells(MR + 4, 1) <> ws.Cells(MR + 4, 2) Then
ws.Range("xfd1") = "False"
Else: ws.Range("xfd1") = "True"
End If
nextws:    Next



End Sub



Sub Sum_Check_All()
   
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceRcount As Long, FNum As Long, myrow As Long, myrow1 As Long
    Dim mybook As Workbook, BaseWks As Workbook, sh As Worksheet
    Dim sourceRange As Range, destrange As Range, Rng As Range
    Dim rnum As Long, CalcMode As Long

    ' Change this to the path\folder location of your files.
    'MyPath = Worksheets("sheet2").Range("A2").Value
    Application.ScreenUpdating = False
'Put this macro in folder remove that folder all files
'myPath = Application.ThisWorkbook.Path & "\"
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    MyPath = .SelectedItems(1) & "\"
End With

    ' Add a slash at the end of the path if needed.
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If

    ' If there are no Excel files in the folder, exit.
    FilesInPath = Dir(MyPath & "*.xlsx*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    ' Fill the myFiles array with the list of Excel files
    ' in the search folder.
    FNum = 0
    Do While FilesInPath <> ""
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        MyFiles(FNum) = FilesInPath
        FilesInPath = Dir()
    Loop

    ' Set various application properties.
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Add a new workbook with one sheet.
    Set BaseWks = ThisWorkbook
   

    ' Loop through all files in the myFiles array.
    If FNum > 0 Then
        For FNum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
            For Each sh In mybook.Worksheets
            myrow1 = BaseWks.Sheets("Sum Err").Range("a" & Rows.Count).End(xlUp).Row
           
            SumCheck
            If sh.Range("xfd1") = "False" Then
            BaseWks.Sheets("Sum Err").Cells(myrow1 + 1, 1) = mybook.Name
            BaseWks.Sheets("Sum Err").Cells(myrow1 + 1, 2) = sh.Name
            End If
           
           
            Next
            'mybook.Save
            Application.DisplayAlerts = False
            mybook.Close SaveChanges:=False
            Application.DisplayAlerts = True
            On Error GoTo 0


        Next FNum
       
        On Error Resume Next
        BaseWks.Save
        If Err.Number = 1004 Then
        MsgBox "Please Save This New Workbook With New Name :-)", vbInformation
       
        End If
       
End If
   
ExitTheSub:
    ' Restore the application properties.
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
MsgBox "Thanks for using :-)"

End Sub
 

But this code is already looping worksheets like in post #9 !

Just think about what must be done inside or outside the loop …
​
 
You must log in or register to reply here.
Back
Top