Solved

Reworking of previous solution of adding Loading Fee from Mastercard Sheets

Posted on 2012-04-05
17
528 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
  • 10
  • 4
  • 3
17 Comments
 
LVL 45

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 29

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
 

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 45

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 29

Accepted Solution

by:
gowflow earned 500 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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

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 29

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 45

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 45

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
 

Author Comment

by:JaseSt
ID: 37920198
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

Suggested Solutions

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…

708 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

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now