• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 562
  • Last Modified:

Excel - VBA (Formula- Updated)

SiddharthRout helped me with the following VBA codes last week.  I have since added more columns to the spreadsheet so the calculations will have to be done on differnet columns.  The attached spreadsheet includes the updated formulas.  The Calculations should be done on the Destination worksheet, 3 rows after the last data row.

Everything else should remain the same.

Codes:
Sub Sample()
    Dim wb As Workbook, ws As Worksheet
    Dim LastRow As Long, DestRow As Long
    Dim StrFile As String
    Dim msgFooter As String
   
    '~~> Footer Message
    msgFooter = "Note: Account detail reports were posted to the BOM and Service Reports Portal in the Specials section." & Chr(10) & _
            "Reports are called:" & Chr(10) & _
            "Connect Edelivery-New Accts Enrolled April 1-15" & Chr(10) & _
            "Connect SAC-New Accts With SAC April 1-15" & Chr(10) & _
            "Connect FreeForever IRA-New Accts Enrolled April 1-15"
     
   
    StrFile = Dir$(MyFolder & "*.xls")
   
    Do While Len(StrFile)
        Set wb = Workbooks.Open(MyFolder & StrFile)
        Set ws = Sheets("DESTINATION")
       
        LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
        DestRow = LastRow + 3
       
        ws.Range("D" & DestRow) = "Complex Totals"
        ws.Range("G" & DestRow).Formula = "=SUM(G6:G" & DestRow - 1 & ")"
        ws.Range("G" & DestRow).Copy
        ws.Range("T" & DestRow & ":V" & DestRow & ",P" & DestRow & ":R" & DestRow & ",M" & DestRow & _
        ":N" & DestRow & ",J" & DestRow & ":K" & DestRow & ",H" & DestRow).PasteSpecial Paste:=xlPasteFormulas, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
       
        ws.Range("I" & DestRow).Formula = "=H" & DestRow & "/G" & DestRow
        ws.Range("L" & DestRow).Formula = "=(K" & DestRow & "/J" & DestRow & ")-$I$" & DestRow
        ws.Range("O" & DestRow).Formula = "=(N" & DestRow & "/M" & DestRow & ")-$I$" & DestRow
        ws.Range("S" & DestRow).Formula = "=(Q" & DestRow & "+R" & DestRow & ")/P" & DestRow
        ws.Range("W" & DestRow).Formula = "=(U" & DestRow & "+V" & DestRow & ")/T" & DestRow
        ws.Range("X" & DestRow).Formula = "=O" & DestRow & "+S" & DestRow & "+W" & DestRow
       
        ws.Rows(DestRow).NumberFormat = "0"
        ws.Range("I" & DestRow & ",L" & DestRow & ",O" & DestRow & ",S" & DestRow & _
        ",W" & DestRow & ",X" & DestRow).NumberFormat = "0.00%"
       
        '~~> Add the relevent Text to the Footer
        With ws.PageSetup
            .LeftFooter = msgFooter
        End With
       
   
        Application.StatusBar = " File " & wb.Name & " is being processed..."
        wb.Close SaveChanges:=True
        StrFile = Dir
    Loop
   
    MsgBox "Done"
   
    Set ws = Nothing
    Set wb = Nothing
End Sub
31-WEST-52ND-ST.xls
0
ArisaAnsar
Asked:
ArisaAnsar
  • 7
  • 6
1 Solution
 
SiddharthRoutCommented:
Try this

Sub Sample()
    Dim wb As Workbook, ws As Worksheet
    Dim LastRow As Long, DestRow As Long
    Dim StrFile As String
    Dim msgFooter As String
   
    '~~> Footer Message
    msgFooter = "Note: Account detail reports were posted to the BOM and Service Reports Portal in the Specials section." & Chr(10) & _
            "Reports are called:" & Chr(10) & _
            "Connect Edelivery-New Accts Enrolled April 1-15" & Chr(10) & _
            "Connect SAC-New Accts With SAC April 1-15" & Chr(10) & _
            "Connect FreeForever IRA-New Accts Enrolled April 1-15"
     
   
    StrFile = Dir$(MyFolder & "*.xls")
   
    Do While Len(StrFile)
        Set wb = Workbooks.Open(MyFolder & StrFile)
        Set ws = Sheets("DESTINATION")
       
        LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
        DestRow = LastRow + 3
       
        ws.Range("D" & DestRow) = "Complex Totals"
        ws.Range("G" & DestRow).Formula = "=SUM(G6:G" & DestRow - 1 & ")"
        ws.Range("G" & DestRow).Copy
        ws.Range("H" & DestRow & ",J" & DestRow & ":K" & DestRow & ",M" & DestRow & ":N" & DestRow & _
       ",P" & DestRow & ":Q" & DestRow & ",S" & DestRow & ":W" & DestRow & ",Y" & DestRow & _
       ":Z" & DestRow & ",AA" & DestRow & ":AB" & DestRow).PasteSpecial Paste:=xlPasteFormulas, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
       
        ws.Range("I" & DestRow).Formula = "=H" & DestRow & "/G" & DestRow
        ws.Range("L" & DestRow).Formula = "=(K" & DestRow & "/J" & DestRow & ")-$I$" & DestRow
        ws.Range("O" & DestRow).Formula = "=(N" & DestRow & "/M" & DestRow & ")-$I$" & DestRow
        ws.Range("R" & DestRow).Formula = "=(Q" & DestRow & "+P" & DestRow & ")/I" & DestRow
        ws.Range("X" & DestRow).Formula = "=(U" & DestRow & "+V" & DestRow & "+W" & DestRow & ")/T" & DestRow
        ws.Range("AC" & DestRow).Formula = "=(Z" & DestRow & "+AA" & DestRow & "+AB" & DestRow & ")/Y" & DestRow
        ws.Range("AD" & DestRow).Formula = "=R" & DestRow & "+X" & DestRow & "+AC" & DestRow
       
        ws.Rows(DestRow).NumberFormat = "0"
        ws.Range("I" & DestRow & ",L" & DestRow & ",O" & DestRow & ",R" & DestRow & _
        ",X" & DestRow & ",AC" & DestRow & ",AD" & DestRow).NumberFormat = "0.00%"
       
        '~~> Add the relevent Text to the Footer
        With ws.PageSetup
            .LeftFooter = msgFooter
        End With
       
   
        Application.StatusBar = " File " & wb.Name & " is being processed..."
        wb.Close SaveChanges:=True
        StrFile = Dir
    Loop
   
    MsgBox "Done"
   
    Set ws = Nothing
    Set wb = Nothing
End Sub

Open in new window


Sid
0
 
ArisaAnsarAuthor Commented:
Hi Sid,
I'm getting the following error message:

"Run Time Error '104."
Unable to set the LeftFooter propery of the PageSetup Class."
0
 
SiddharthRoutCommented:
I haven't touched that part of the code.

Let me go through the code gain.

Sid
0
Independent Software Vendors: 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!

 
ArisaAnsarAuthor Commented:
Hi,
I'm will be traveling within the next hour but will be able to test after 9:00 PM tonight.
0
 
ArisaAnsarAuthor Commented:
The files will have the old footer from last time I ran the code.  I know there is a character limit so not sure if the code is trying to paste again to the footer instead of over writing the the existing.
0
 
SiddharthRoutCommented:
No that is ok.

Well, I deleted some text from

    '~~> Footer Message
    msgFooter = "Note: Account detail reports were posted to the BOM and Service Reports Portal in the Specials section." & Chr(10) & _
            "Reports are called:" & Chr(10) & _
            "Connect Edelivery-New Accts Enrolled April 1-15" & Chr(10) & _
            "Connect SAC-New Accts With SAC April 1-15" & Chr(10) & _
            "Connect FreeForever IRA-New Accts Enrolled April 1-15"
     
and the macro ran perfectly.

Sid
0
 
SiddharthRoutCommented:
I used this and it worked perfectly.

    '~~> Footer Message
    msgFooter = "Account detail reports were posted to BOM & Service Reports Portal in Specials section." & Chr(10) & _
            "Reports are called:" & Chr(10) & _
            "Connect Edelivery-New Accts Enrolled April 1-15" & Chr(10) & _
            "Connect SAC-New Accts With SAC April 1-15" & Chr(10) & _
            "Connect FreeForever IRA-New Accts Enrolled April 1-15"

Sid
0
 
ArisaAnsarAuthor Commented:
Thanks very much. I will test it again in one hour.

0
 
ArisaAnsarAuthor Commented:
Thank you!  Thank you!
You are truely a Genius!!
This was perfect.
0
 
ArisaAnsarAuthor Commented:
Hi Sid,
In this section of the code, where the columns are being Sum, you have some columns identify with a semicolon and some identify with a comma.  What is the difference?   I bolded two examples below.
I have to update the codes to calculate on more columns but did not know if I should use a coma or a semi colon.

ws.Range("D" & DestRow) = "Complex Totals"
        ws.Range("G" & DestRow).Formula = "=SUM(G6:G" & DestRow - 1 & ")"
        ws.Range("G" & DestRow).Copy
        ws.Range("T" & DestRow & ":V" & DestRow & ",P" & DestRow & ":R" & DestRow & ",M" & DestRow & _
        ":N" & DestRow & ",J" & DestRow & ":K" & DestRow & ",H" & DestRow).PasteSpecial Paste:=xlPasteFormulas, _
0
 
SiddharthRoutCommented:
If you want to select say cells A1, B1, C1 then you can write them in two ways

A1:C1

or

A1,B1,C1

Please note that ":" is used if the cells are continuous like A~>B~>C

Now let's take another example.

If you want to select A1, C1, E1 then you cannot use

A1:E1 as this will include Cells B1 and D1. In such a case you will use "," so it becomes

A1,C1,D1

Hope this helps :)

Sid
0
 
ArisaAnsarAuthor Commented:

Thank you very much.  That helps.

Can you close the question I just posted for this same issue.  I received a werid email from Expert Exchange so I taught you would not be able to see this?

Also, can you look at my other question which I posted a few days ago regard Access VBA.  It really is for Excel VBA.  I don't understand the help I'm currently getting.
0
 
SiddharthRoutCommented:
>>> I don't understand the help I'm currently getting.

Arisa

In reference to this thread (I guess you are referring to http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_26964864.html )

Akoster is an experienced Expert. Since he has already started helping, I would suggest that you address him directly regarding the problems that you are facing and I am sure he will be able to clear them out. If he is not then I will step in :) I will however still have a look at that thread :)

Sid
0

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

  • 7
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now