Reworking of previous solution of adding Loading Fee from Mastercard Sheets

The attached code was reworked by gowflow. It goes thru the Mastercard workbook, summing up values in Col  L where the date in Col K = the previous month and then puts that total in the Final Report sheet for that month.

According to the previous request, it does this for all sheets Except where MC precedes the name of the sheet and also Main, Final Report . However, I need to have it perform this function on all sheets that is preceded by 'MCR' and 'HMF' and 'OS' as well.

I believe the original question was this: http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_26911784.html - BUT GOWFLOW REWORKED IT AS I REMEMBER.

Please ask if any questions. Here is the code reworked by gowflow

Sub SumUpTheValues()
Dim wbk                                 As Workbook
Dim sht                                 As Worksheet
Dim rngRandom                           As Range
'Modified by gowflow to account for 2 years last and this year
Dim TYarrMonthsValues(1 To 12, 1 To 2)    As Variant
Dim LYarrMonthsValues(1 To 12, 1 To 2)    As Variant

Dim I                                   As Integer
Dim lngColumnHeader                     As Long
'Modified by gowflow to qccount for 2 years last and this year
Dim TYstrArrayFormula                     As String
Dim LYstrArrayFormula                     As String


    If MsgBox("This procedure will run thru all worksheets in this workbook and compile data" _
        & " for the creation of Final Report" & Chr(10) & Chr(10) _
        & "Ready to create Final Report ?", vbQuestion + vbYesNo, "Final Report Creation") = vbYes Then
       
        Set wbk = ActiveWorkbook
       
        'Modified by gowflow to account for 2 years This year and Last year
        For I = 1 To 12
                TYarrMonthsValues(I, 1) = "'" & VBA.Format(VBA.DateSerial(Year(Now), I, 1), "MMM/YY")
                LYarrMonthsValues(I, 1) = "'" & VBA.Format(VBA.DateSerial(Year(Now) - 1, I, 1), "MMM/YY")
        Next
       
        For Each sht In wbk.Worksheets
            If VBA.Left(sht.Name, 2) <> "MC" And _
               sht.Name <> "Main" And _
               sht.Name <> "Final Report" Then
               
                lngColumnHeader = fnColumnNumber(sht, "Load Fee")
               
                'Added by gowflow as some sheets have Loding Fee and not Load Fee
                If lngColumnHeader = 0 Then lngColumnHeader = fnColumnNumber(sht, "Loading Fee")
               
                If lngColumnHeader <> 0 Then
                    Set rngRandom = fnDetermineRandomRange(sht)
                    If rngRandom Is Nothing Then
                        'Exit Sub
                    Else
                        Sheets("Main").Range("L1048576").End(xlUp).Offset(1, 0).Cells(1) = "Sheet: " & sht.Name & " Beeing Processed"

                        For I = 1 To 12
                            'New Final outcome of formula as per gowflow
                            '=SUM(N(NOT(ISBLANK(K2:K21)))*N(MONTH(K2:K21)=8)*N(YEAR(K2:K21)=2011)*L2:L21)
                           
                            'Old caluclation
                            'strArrayFormula = "=SUM(NOT((ISBLANK(K2:K" & rngRandom.Row & ")))*(MONTH(K2:K" & rngRandom.Row & ")=" & I & ")*L2:L" & rngRandom.Row & ")"
                            TYstrArrayFormula = "=SUM(N(NOT(ISBLANK(K2:K" & rngRandom.Row - 1 & ")))*N(MONTH(K2:K" & rngRandom.Row - 1 & ")=" & I & ")*N(YEAR(K2:K" & rngRandom.Row - 1 & ")=" & Year(Now) & ")*L2:L" & rngRandom.Row - 1 & ")"
                            LYstrArrayFormula = "=SUM(N(NOT(ISBLANK(K2:K" & rngRandom.Row - 1 & ")))*N(MONTH(K2:K" & rngRandom.Row - 1 & ")=" & I & ")*N(YEAR(K2:K" & rngRandom.Row - 1 & ")=" & Year(Now) - 1 & ")*L2:L" & rngRandom.Row - 1 & ")"
                            'Update Trace
                                     
                            If Not rngRandom Is Nothing Then
                                Application.EnableEvents = False
                                    'Record Values for this Year specific Month
                                    rngRandom.FormulaArray = TYstrArrayFormula
                                    If IsNumeric(rngRandom.Value) Then
                                        TYarrMonthsValues(I, 2) = TYarrMonthsValues(I, 2) + rngRandom.Value
                                        Sheets("Main").Range("H16") = "This Year: "
                                        Sheets("Main").Range("I16") = I
                                        Sheets("Main").Range("J16") = TYarrMonthsValues(I, 2)
                                    End If
                                   
                                    'Record Values for Last Year specific Month
                                    rngRandom.FormulaArray = LYstrArrayFormula
                                    If IsNumeric(rngRandom.Value) Then
                                        LYarrMonthsValues(I, 2) = LYarrMonthsValues(I, 2) + rngRandom.Value
                                        Sheets("Main").Range("H17") = "Last Year: "
                                        Sheets("Main").Range("I17") = I
                                        Sheets("Main").Range("J17") = LYarrMonthsValues(I, 2)
                                    End If
                                Application.EnableEvents = True
                            End If
                        Next
                   
                    End If
                    'Added by gowflow to remove formula Array after completion
                    Application.EnableEvents = False
                    rngRandom.Formula = ""
                    Set rngRandom = Nothing
                   
                    Application.EnableEvents = True
                    DoEvents
                End If
               
            End If
        Next
       
        Call DeleteFinalReport(wbk)
        Set sht = wbk.Sheets.Add(after:=wbk.Sheets("Main"))
        With sht
            'Last Year Figures
            .Range("A1").Value = "MONTH"
            .Range("B1").Value = "VALUE"
            .Range("A1:B1").Font.Bold = True
            .Range(.Cells(2, 1), .Cells(13, 2)).Value = LYarrMonthsValues
            .Range("B:B").NumberFormat = "$ ###,###,##0.00"
           
            'This Year Figures
            .Range("C1").Value = "MONTH"
            .Range("D1").Value = "VALUE"
            .Range("C1:D1").Font.Bold = True
            .Range(.Cells(2, 3), .Cells(13, 4)).Value = TYarrMonthsValues
            .Range("D:D").NumberFormat = "$ ###,###,##0.00"
            .Columns("A:D").AutoFit

            .Name = "Final Report"
        End With
        Set sht = Nothing
        Set wbk = Nothing
    End If
End Sub




Private Function fnColumnNumber(sht As Worksheet, strColumnHeader As String) As Long
On Error Resume Next
    fnColumnNumber = Application.WorksheetFunction.Match(strColumnHeader, sht.Rows(1), 0)
End Function

Private Function fnDetermineRandomRange(sht As Worksheet) As Range
On Error Resume Next
    'Changed by gowflow as this routine to locate last row does not perform correctly
    'Set fnDetermineRandomRange = sht.UsedRange.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Cells(1)
   
    Set fnDetermineRandomRange = sht.Range("K1048576").End(xlUp).Offset(1, 1).Cells(1)
End Function

Private Sub DeleteFinalReport(wbk As Workbook)
On Error Resume Next
    With Application
        .DisplayAlerts = False
        MsgBox ("Will delete Final Report Sheet !!!")
        wbk.Sheets("Final Report").Delete
        .DisplayAlerts = True
    End With
End Sub
JaseStAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
gowflowConnect With a Mentor Commented:
JaseSt,

Sorry for Extended Late reply !!!

I guess this is what you need:

1) make a new copy of your latest MC file and give it a new name
2) open it and goto vba and doubleclick on module4 and view 1 sub at a time by clicking on the below left icon
3) locate sub SumUpTheValues and delete it.
4) PAste the below code there.

Sub SumUpTheValues()
Dim wbk                                 As Workbook
Dim sht                                 As Worksheet
Dim rngRandom                           As Range
'Modified by gowflow to account for 2 years last and this year
Dim TYarrMonthsValues(1 To 12, 1 To 2)    As Variant
Dim LYarrMonthsValues(1 To 12, 1 To 2)    As Variant

Dim I                                   As Integer
Dim lngColumnHeader                     As Long
'Modified by gowflow to qccount for 2 years last and this year
Dim TYstrArrayFormula                     As String
Dim LYstrArrayFormula                     As String


    If MsgBox("This procedure will run thru all worksheets in this workbook and compile data" _
        & " for the creation of Final Report" & Chr(10) & Chr(10) _
        & "Ready to create Final Report ?", vbQuestion + vbYesNo, "Final Report Creation") = vbYes Then
        
        Set wbk = ActiveWorkbook
        
        'Modified by gowflow to account for 2 years This year and Last year
        For I = 1 To 12
                TYarrMonthsValues(I, 1) = "'" & VBA.Format(VBA.DateSerial(Year(Now), I, 1), "MMM/YY")
                LYarrMonthsValues(I, 1) = "'" & VBA.Format(VBA.DateSerial(Year(Now) - 1, I, 1), "MMM/YY")
        Next
        
        For Each sht In wbk.Worksheets
            If VBA.Left(sht.Name, 3) <> "MC " And _
               sht.Name <> "Main" And _
               sht.Name <> "Final Report" Then
                
                lngColumnHeader = fnColumnNumber(sht, "Load Fee")
                
                'Added by gowflow as some sheets have Loding Fee and not Load Fee
                If lngColumnHeader = 0 Then lngColumnHeader = fnColumnNumber(sht, "Loading Fee")
                
                If lngColumnHeader <> 0 Then
                    Set rngRandom = fnDetermineRandomRange(sht)
                    If rngRandom Is Nothing Then
                        'Exit Sub
                    Else
                        Sheets("Main").Range("L1048576").End(xlUp).Offset(1, 0).Cells(1) = "Sheet: " & sht.Name & " Beeing Processed"

                        For I = 1 To 12
                            'New Final outcome of formula as per gowflow
                            '=SUM(N(NOT(ISBLANK(K2:K21)))*N(MONTH(K2:K21)=8)*N(YEAR(K2:K21)=2011)*L2:L21)
                            
                            'Old caluclation
                            'strArrayFormula = "=SUM(NOT((ISBLANK(K2:K" & rngRandom.Row & ")))*(MONTH(K2:K" & rngRandom.Row & ")=" & I & ")*L2:L" & rngRandom.Row & ")"
                            TYstrArrayFormula = "=SUM(N(NOT(ISBLANK(K2:K" & rngRandom.Row - 1 & ")))*N(MONTH(K2:K" & rngRandom.Row - 1 & ")=" & I & ")*N(YEAR(K2:K" & rngRandom.Row - 1 & ")=" & Year(Now) & ")*L2:L" & rngRandom.Row - 1 & ")"
                            LYstrArrayFormula = "=SUM(N(NOT(ISBLANK(K2:K" & rngRandom.Row - 1 & ")))*N(MONTH(K2:K" & rngRandom.Row - 1 & ")=" & I & ")*N(YEAR(K2:K" & rngRandom.Row - 1 & ")=" & Year(Now) - 1 & ")*L2:L" & rngRandom.Row - 1 & ")"
                            'Update Trace
                                     
                            If Not rngRandom Is Nothing Then
                                Application.EnableEvents = False
                                    'Record Values for this Year specific Month
                                    rngRandom.FormulaArray = TYstrArrayFormula
                                    If IsNumeric(rngRandom.Value) Then
                                        TYarrMonthsValues(I, 2) = TYarrMonthsValues(I, 2) + rngRandom.Value
                                        Sheets("Main").Range("H16") = "This Year: "
                                        Sheets("Main").Range("I16") = I
                                        Sheets("Main").Range("J16") = TYarrMonthsValues(I, 2)
                                    End If
                                    
                                    'Record Values for Last Year specific Month
                                    rngRandom.FormulaArray = LYstrArrayFormula
                                    If IsNumeric(rngRandom.Value) Then
                                        LYarrMonthsValues(I, 2) = LYarrMonthsValues(I, 2) + rngRandom.Value
                                        Sheets("Main").Range("H17") = "Last Year: "
                                        Sheets("Main").Range("I17") = I
                                        Sheets("Main").Range("J17") = LYarrMonthsValues(I, 2)
                                    End If
                                Application.EnableEvents = True
                            End If
                        Next
                    
                    End If
                    'Added by gowflow to remove formula Array after completion
                    Application.EnableEvents = False
                    rngRandom.Formula = ""
                    Set rngRandom = Nothing
                    
                    Application.EnableEvents = True
                    DoEvents
                End If
                
            End If
        Next
        
        Call DeleteFinalReport(wbk)
        Set sht = wbk.Sheets.Add(after:=wbk.Sheets("Main"))
        With sht
            'Last Year Figures
            .Range("A1").Value = "MONTH"
            .Range("B1").Value = "VALUE"
            .Range("A1:B1").Font.Bold = True
            .Range(.Cells(2, 1), .Cells(13, 2)).Value = LYarrMonthsValues
            .Range("B:B").NumberFormat = "$ ###,###,##0.00"
            
            'This Year Figures
            .Range("C1").Value = "MONTH"
            .Range("D1").Value = "VALUE"
            .Range("C1:D1").Font.Bold = True
            .Range(.Cells(2, 3), .Cells(13, 4)).Value = TYarrMonthsValues
            .Range("D:D").NumberFormat = "$ ###,###,##0.00"
            .Columns("A:D").AutoFit

            .Name = "Final Report"
        End With
        Set sht = Nothing
        Set wbk = Nothing
    End If
End Sub

Open in new window


5) SAVE and Exit the workbook.
6) Give it a try.

Appreciate you let me know at once if it does it (to test it even if it is not the end of the month just after creating this new copy make an extra copy and test it. It should give you if it is working properly.

I am not logging often here reason why if you need help I will monitor in the next 2 days.

Rgds and again sorry for late reply.
gowflow
0
 
Martin LissOlder than dirtCommented:
It looks to me like it will allow all sheets except MC, Main and Final Report so it should allow 'MCR' and 'HMF' and 'OS. Do you want to exclude those last 3?
0
 
JaseStAuthor Commented:
I want it to allow (add up from) the sheets that have the prefix: MCR, HMF and OS and exclude sheets that have MC as the prefix (MCR I want but not MC), Main and Final Report
0
[Webinar] Improve your customer journey

A positive customer journey is important in attracting and retaining business. To improve this experience, you can use Google Maps APIs to increase checkout conversions, boost user engagement, and optimize order fulfillment. Learn how in this webinar presented by Dito.

 
gowflowCommented:
Sorry Jasest was off for sometimes needed a break, if your still intrested I will look at this one. Let me know
gowflow
0
 
JaseStAuthor Commented:
Yes. please go for it, gowflow. Thank you.
0
 
JaseStAuthor Commented:
any update gowflow?
0
 
Martin LissOlder than dirtCommented:
Change
        For Each sht In wbk.Worksheets
            If VBA.Left(sht.Name, 2) <> "MC" And _
               sht.Name <> "Main" And _
               sht.Name <> "Final Report" Then

to this


 For Each sht In wbk.Worksheets
    If VBA.Left(sht.Name, 3) = "MCR" Or _
       VBA.Left(sht.Name, 3) = "HMF" Or _
       VBA.Left(sht.Name, 2) = "OS" Then
0
 
JaseStAuthor Commented:
Thanks MarinLiss. I'll give it a try shortly. I usually use this script at the start of a new month but will test it soon.
0
 
JaseStAuthor Commented:
Worked perfectly gowflow. Thank you very much.
So are you not going to do experts exchange anymore?
0
 
gowflowCommented:
Yes for sure I will but I was a bit sidetrack for a while. Now back in focus !!! :) for sure always intrested to assist you (tks for having been patient !!!). Any new stuff ?
gowflow
0
 
JaseStAuthor Commented:
Wonderful! Yes, I do have stuff.

What I have immediately is a reworking of the Import WU Emails function that is implemented with clicking that button on the Main sheet of the Visa workbook.

What is happening is that in addition to pickups from Western Union we are now picking up from MoneyGram so the "Reference#" label now has "MG#:" I inserted the change into into the code and it says it says correctly imported the pickup requests into the spreadsheet but it doesn't.

I'll explain further in the new question. The link to it is here:

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27693076.html
0
 
JaseStAuthor Commented:
Hi gowflow. Just ran this for April 2012 and for the Mastercard totals it is only giving me $351.68 for the USD Fees. It should be a LOT more than that. Not sure why it's doing that, am checking to see if I can find something. It worked before the latest edit but of course is was missing some sheets.
0
 
Martin LissOlder than dirtCommented:
IMO the sheet selection code in goflow's solution isn't correct. Try the change I suggested in my post ID 37856452.
0
 
JaseStAuthor Commented:
Thanks MartinLiss. I tried your code and got the exact same results. Must be something else?
0
 
Martin LissOlder than dirtCommented:
Why don't you create a new question that refers to this one and we (and possibly others) can talk more.
0
 
JaseStAuthor Commented:
sure will do and will post link to it here in a minute or two
0
 
JaseStAuthor Commented:
0
All Courses

From novice to tech pro — start learning today.