Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 398
  • Last Modified:

Excel (Macro) VBA

I have 120 files in a folder and need to calculate each column within each file the same.  Can someone help me write a macro that will perform the same calculation in each spreadsheet?

The rows on each spreadsheet will differ so if the calculations can be placed on the 3rd row after the last data row, that will work.  

SiddharthRout had helped me with this once but the rows in the calculations have changed and I cannot seem to get it to work. Experts-Exchange.xls
0
ArisaAnsar
Asked:
ArisaAnsar
  • 9
  • 7
  • 2
  • +1
1 Solution
 
Patrick MatthewsCommented:
Can you provide a live example?
0
 
ArisaAnsarAuthor Commented:
Hi,
The file is attached.  Did you see it?
0
 
Patrick MatthewsCommented:
Yes, it's there.  Sorry :)
0
Technology Partners: 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!

 
DreamboatCommented:
Arisa, I am sure MatthewsPatrick will do a fine job helping you. I would like to suggest, however, that you put your totals on the FIRST row of your worksheets from now on. Makes it so much simpler. I still forget to do it myself, even though it makes such sense. :)

(Hi, MP!)
0
 
ArisaAnsarAuthor Commented:
MatthesPatrick,
Any luck on this one?  Any advice would be appreciated.
0
 
SiddharthRoutCommented:
Hello Jennifer.

I remember this file :)

Do you still have the old code. I can rectify that code for you :)

Sid
0
 
ArisaAnsarAuthor Commented:
I meant to make a copy and save it before I start changing it and did not do that.  I started to modify this one but its not complete:

Option Explicit

Const MyFolder As String = "T:\Jennifer\Investment Support Campaign\ComplexReports\"

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 = "Account detail reports were posted to BOM and Reports Portal in Specials section." & Chr(10) & _
            "Reports are called:" & Chr(10) & _
            "Investment Support-Reserved Accts Oct 14" & Chr(10) & _
            "Investment Support-SBL Oct 14" & Chr(10) & _
            "Investment Support-Insurace-Annuities Oct 14"

     
   
    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 & ":T" & DestRow & ",V" & DestRow & ":W" & DestRow).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
       
       
      'Securities Based Lending
       
        ws.Range("i" & DestRow).Formula = "=(H" & DestRow & "-G" & DestRow & ")/G" & DestRow
        ws.Range("l" & DestRow).Formula = "=(K" & DestRow & "-J" & DestRow & "/J" & DestRow
       

     'Insurance
        ws.Range("0" & DestRow).Formula = "=(N" & DestRow & "-M" & DestRow & ")/M" & DestRow
           
     'Annuities
        ws.Range("R" & DestRow).Formula = "=(Q" & DestRow & "-P" & DestRow & ")/P" & DestRow
     
     'Reserved
        ws.Range("U" & DestRow).Formula = "=(T" & DestRow /S" & DestRow"
       
        ws.Range("BO" & DestRow).Formula = "=(BE" & DestRow & "+BF" & DestRow & "+BG" & DestRow & "+BH" & DestRow & "+BI" & DestRow & "+BJ" & DestRow & "+BK" & DestRow & "+BL" & DestRow & "+BM" & DestRow & "+BN" & DestRow & ")/BD" & DestRow
   
    'Aggregate Increase
        ws.Range("BP" & DestRow).Formula = "=AM" & DestRow & "+BC" & DestRow & "+BO" & DestRow

        ws.Rows(DestRow).NumberFormat = "0"
        ws.Range("I" & DestRow & ",L" & DestRow & ",O" & DestRow & ",R" & DestRow & _
        ",U" & DestRow & ",X" & DestRow & ",AA" & DestRow & ",AD" & DestRow & ",AG" & DestRow & ",AJ" & DestRow & ",AM" & DestRow & ",BC" & DestRow & ",BO" & DestRow & ",BP" & DestRow).NumberFormat = "0.000%"

     
        '~~> 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
0
 
SiddharthRoutCommented:
Is this what you are trying?

ws.Range("I" & DestRow).Formula = "=(H" & DestRow & "-G" & DestRow & ")/G" & DestRow

Open in new window


Sid
0
 
SiddharthRoutCommented:
In fact I just noticed the code that you posted above. The code is correct. What exactly is the problem that you are facing?

Sid
0
 
ArisaAnsarAuthor Commented:
Yes, that row is working.
I'm getting an error on this row and cannot figure out why?   It has to do the same as teh row you listed above.



 ws.Range("l" & DestRow).Formula = "=(K" & DestRow & "-J" & DestRow & "/J" & DestRow
0
 
ArisaAnsarAuthor Commented:
Sid
This is the entire code that I modified:

Option Explicit

Const MyFolder As String = "T:\Jennifer\Investment Support Campaign\ComplexReports\"

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 = "Account detail reports were posted to BOM and Reports Portal in Specials section." & Chr(10) & _
            "Reports are called:" & Chr(10) & _
            "Investment Support-Reserved Accts Oct 14" & Chr(10) & _
            "Investment Support-SBL Oct 14" & Chr(10) & _
            "Investment Support-Insurace-Annuities Oct 14"

     
   
    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 & ":T" & DestRow & ",V" & DestRow & ":W" & DestRow).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
       
       
      'Securities Based Lending
       
        ws.Range("i" & DestRow).Formula = "=(H" & DestRow & "-G" & DestRow & ")/G" & DestRow
        ws.Range("l" & DestRow).Formula = "=(K" & DestRow & "-J" & DestRow & "/J" & DestRow
       

     'Insurance
        ws.Range("0" & DestRow).Formula = "=(N" & DestRow & "-M" & DestRow & ")/M" & DestRow
           
     'Annuities
        ws.Range("R" & DestRow).Formula = "=(Q" & DestRow & "-P" & DestRow & ")/P" & DestRow
     
     'Reserved
        ws.Range("U" & DestRow).Formula = "=T" & DestRow / "=S" & DestRow
        ws.Range("X" & DestRow).Formula = "=W" & DestRow / "=V" & DestRow
        ws.Range("Y" & DestRow).Formula = "=X" & DestRow - "=U" & DestRow
         
    'Aggregate Increase
        ws.Range("X" & DestRow).Formula = "=Y" & DestRow & "+R" & DestRow & "+O" & DestRow & "+L" & DestRow

        ws.Rows(DestRow).NumberFormat = "0"
        ws.Range("I" & DestRow & ",L" & DestRow & ",O" & DestRow & ",R" & DestRow & _
        ",U" & DestRow & ",X" & DestRow & ",Y" & DestRow & ",Z" & DestRow).NumberFormat = "0.000%"

     
        '~~> 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



0
 
SiddharthRoutCommented:
You are missing a bracket ;)

Let me see if you can find which one ;)

Sid
0
 
SiddharthRoutCommented:
>>>>ws.Range("l" & DestRow).Formula = "=(K" & DestRow & "-J" & DestRow & "/J" & DestRow

You are missing a bracket in this :)

Compare it with

ws.Range("I" & DestRow).Formula = "=(H" & DestRow & "-G" & DestRow & ")/G" & DestRow

Sid
0
 
SiddharthRoutCommented:
Try this

ws.Range("L" & DestRow).Formula = "=(K" & DestRow & "-J" & DestRow & ")/J" & _
DestRow

Open in new window

0
 
ArisaAnsarAuthor Commented:
Of course as soon as I posted it, I saw that error.  Thank you.

I'm getting a type mismatch here.  I'm sure it has to do with the division sign but its not working when I placed the division sign next to the column.

 'Reserved
        ws.Range("U" & DestRow).Formula = "=T" & DestRow / "=S" & DestRow
        ws.Range("X" & DestRow).Formula = "=W" & DestRow / "=V" & DestRow
        ws.Range("Y" & DestRow).Formula = "=X" & DestRow - "=U" & DestRow
0
 
SiddharthRoutCommented:
Is this what you are trying?
ws.Range("U" & DestRow).Formula = "=T" & DestRow & "/S" & DestRow
ws.Range("X" & DestRow).Formula = "=W" & DestRow & "/V" & DestRow
ws.Range("Y" & DestRow).Formula = "=X" & DestRow & "/U" & DestRow

Open in new window


Sid
0
 
SiddharthRoutCommented:
Sorry, Change the last line to

ws.Range("Y" & DestRow).Formula = "=X" & DestRow & "-U" & DestRow

Open in new window

0
 
ArisaAnsarAuthor Commented:
Worked perfectly.  Thank you very much.
0
 
SiddharthRoutCommented:
Glad to be of help :)

Sid
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 9
  • 7
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now