?
Solved

Reworking of previous solution of adding Loading Fee from Mastercard Sheets

Posted on 2012-04-05
17
Medium Priority
?
540 Views
Last Modified: 2012-05-02
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
0
Comment
Question by:JaseSt
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 10
  • 4
  • 3
17 Comments
 
LVL 49

Expert Comment

by:Martin Liss
ID: 37813211
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
 

Author Comment

by:JaseSt
ID: 37826285
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
 
LVL 31

Expert Comment

by:gowflow
ID: 37837564
Sorry Jasest was off for sometimes needed a break, if your still intrested I will look at this one. Let me know
gowflow
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:JaseSt
ID: 37837858
Yes. please go for it, gowflow. Thank you.
0
 

Author Comment

by:JaseSt
ID: 37856214
any update gowflow?
0
 
LVL 49

Expert Comment

by:Martin Liss
ID: 37856452
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
 

Author Comment

by:JaseSt
ID: 37861329
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
 
LVL 31

Accepted Solution

by:
gowflow earned 2000 total points
ID: 37885185
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
 

Author Closing Comment

by:JaseSt
ID: 37891662
Worked perfectly gowflow. Thank you very much.
So are you not going to do experts exchange anymore?
0
 
LVL 31

Expert Comment

by:gowflow
ID: 37895779
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
 

Author Comment

by:JaseSt
ID: 37896904
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
 

Author Comment

by:JaseSt
ID: 37919968
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
 
LVL 49

Expert Comment

by:Martin Liss
ID: 37919994
IMO the sheet selection code in goflow's solution isn't correct. Try the change I suggested in my post ID 37856452.
0
 

Author Comment

by:JaseSt
ID: 37920076
Thanks MartinLiss. I tried your code and got the exact same results. Must be something else?
0
 
LVL 49

Expert Comment

by:Martin Liss
ID: 37920123
Why don't you create a new question that refers to this one and we (and possibly others) can talk more.
0
 

Author Comment

by:JaseSt
ID: 37920136
sure will do and will post link to it here in a minute or two
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

801 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question