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

x
?
Solved

Access VB code to add formula to excel worksheet

Posted on 2008-11-04
11
Medium Priority
?
414 Views
Last Modified: 2013-12-25
I have an export VB code modula that exports certain records to a excel workbook, I need the "L" column in worksheets 11,12, and 13 to have a set formula=IF(L2="","",0-(TODAY()-L2)) for L2:L65536, I have had several problems getting this fuction to work, if you could please help me I would appraciate it greatly.

I have attached an example of the VB code I's trying to add this fuction to fir reference

Public Function HuntingtonAG()
 
 
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheets
Dim MyMonth As String
Dim MyDay As String
Dim MyYear As String
Dim MyTime As String
Dim path As String
Dim MyExtension As String
Dim MyFileName As String
Dim FileFormat As String
Dim Password As String
Dim WriteResPassword As String
Dim ReadOnlyRecommended As String
Dim CreateBackup As String
 
 
Dim rs As Recordset
Dim db As Database
 
Set db = CurrentDb
 
Mydirectory = "\\Tvhviruser.v09.med.va.gov\tvhpublic\MCCR\AR Weekly Report Database\581-Station Weekly Report Database\Weekly Report.xls"
MyNewFile = "\\Tvhviruser.v09.med.va.gov\tvhpublic\MCCR\581-Station Weekly Report\A-G\"
NewFilename = "Weekly Report "
MyMonth = Format(Now, "mm")
MyDay = Format(Now, "dd")
MyYear = Format(Now, "yyyy")
MyTime = Format(Time, "hh.mm.ss")
FileFormat = ".xls"
Password = ""
WriteResPassword = ""
ReadOnlyRecommended = False
CreateBackup = False
MyFileName = MyNewFile + NewFilename + MyMonth + MyDay + MyYear + MyTime + FileFormat
 
Set xlApp = CreateObject("Excel.Application")
Set wb = xlApp.Workbooks.Open(Mydirectory)
 
 
   Do Until wb.Worksheets.Count = 13
   wb.Worksheets.Add
Loop
 
Set rs = db.OpenRecordset("581 (A-G) 0-30 Days")
 
wb.Worksheets(1).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 31-60 Days")
 
wb.Worksheets(2).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 61-90 Days")
 
wb.Worksheets(3).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 91-120 Days")
 
wb.Worksheets(4).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 121-180 Days")
 
wb.Worksheets(5).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 181-365 Days")
 
wb.Worksheets(6).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) Over 365 Days")
 
wb.Worksheets(7).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) Payment/Resid")
 
wb.Worksheets(9).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) Master")
 
wb.Worksheets(10).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 1st Follow Up")
 
wb.Worksheets(11).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 2nd Follow Up")
 
wb.Worksheets(12).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 3rd Follow Up")
 
wb.Worksheets(13).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
 
wb.SaveAs MyFileName
  
'Close Excel
wb.Close savechanges:=False
xlApp.Quit
Set xlApp = Nothing
Set wb = Nothing
Set ws = Nothing
 
End Function

Open in new window

0
Comment
Question by:nelsonje
  • 6
  • 5
11 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22877408
Explicit code to addd the formula is:

    sh.Range("L2:L6").Formula = "=IF(L2="","",0-(TODAY()-L2))"

However are you sure since you are referencing L2 itself in cell L2 ... do you mean for it to be:

    sh.Range("L2:L6").Formula = "=IF(L2="","",0-(TODAY()-L1))" for example?

Chris

Public Function HuntingtonAG()
 
 
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheets
Dim MyMonth As String
Dim MyDay As String
Dim MyYear As String
Dim MyTime As String
Dim path As String
Dim MyExtension As String
Dim MyFileName As String
Dim FileFormat As String
Dim Password As String
Dim WriteResPassword As String
Dim ReadOnlyRecommended As String
Dim CreateBackup As String
 
 
Dim rs As Recordset
Dim db As Database
 
Set db = CurrentDb
 
Mydirectory = "\\Tvhviruser.v09.med.va.gov\tvhpublic\MCCR\AR Weekly Report Database\581-Station Weekly Report Database\Weekly Report.xls"
MyNewFile = "\\Tvhviruser.v09.med.va.gov\tvhpublic\MCCR\581-Station Weekly Report\A-G\"
NewFilename = "Weekly Report "
MyMonth = Format(Now, "mm")
MyDay = Format(Now, "dd")
MyYear = Format(Now, "yyyy")
MyTime = Format(Time, "hh.mm.ss")
FileFormat = ".xls"
Password = ""
WriteResPassword = ""
ReadOnlyRecommended = False
CreateBackup = False
MyFileName = MyNewFile + NewFilename + MyMonth + MyDay + MyYear + MyTime + FileFormat
 
Set xlApp = CreateObject("Excel.Application")
Set wb = xlApp.Workbooks.Open(Mydirectory)
 
 
   Do Until wb.Worksheets.Count = 13
   wb.Worksheets.Add
Loop
 
Set rs = db.OpenRecordset("581 (A-G) 0-30 Days")
 
wb.Worksheets(1).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 31-60 Days")
 
wb.Worksheets(2).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 61-90 Days")
 
wb.Worksheets(3).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 91-120 Days")
 
wb.Worksheets(4).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 121-180 Days")
 
wb.Worksheets(5).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 181-365 Days")
 
wb.Worksheets(6).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) Over 365 Days")
 
wb.Worksheets(7).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) Payment/Resid")
 
wb.Worksheets(9).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) Master")
 
wb.Worksheets(10).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 1st Follow Up")
 
wb.Worksheets(11).Range("A2").CopyFromRecordset rs
wb.Worksheets(11).Range("L2:L65536").Formula = "=IF(L2="","",0-(TODAY()-L1))" for example?
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 2nd Follow Up")
 
wb.Worksheets(12).Range("A2").CopyFromRecordset rs
wb.Worksheets(12).Range("L2:L65536").Formula = "=IF(L2="","",0-(TODAY()-L1))" for example?
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 3rd Follow Up")
 
wb.Worksheets(13).Range("A2").CopyFromRecordset rs
wb.Worksheets(13).Range("L2:L65536").Formula = "=IF(L2="","",0-(TODAY()-L1))" for example?
 
Set rs = Nothing
 
 
wb.SaveAs MyFileName
  
'Close Excel
wb.Close savechanges:=False
xlApp.Quit
Set xlApp = Nothing
Set wb = Nothing
Set ws = Nothing
 
End Function
 

Open in new window

0
 

Author Comment

by:nelsonje
ID: 22877587
I need for it to be a running function for the whole column
example: Column H of worksheet=
=IF(L2="","",0-(TODAY()-L2))
=IF(L3="","",0-(TODAY()-L3))
=IF(L4="","",0-(TODAY()-L4))
so on ...

Do you know how to get it to do this??


 
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22878763
Not sure I follow ... you originally asked:

I need the "L" column in worksheets 11,12, and 13 to have a set formula=IF(L2="","",0-(TODAY()-L2)) for L2:L65536.  Th ecode above is expanded to do just that.

Do you want it to be in the H column range H2:H65536 rather than the L column or can you describe the requirement another way?

CHris
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

Author Comment

by:nelsonje
ID: 22878829
Yes, I typed the wrong Column name.. it needs to be a calulation field in column H with the formula listing in H2:H65536
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22878951
To be sure:

the "H" column in worksheets 11,12, and 13 to have a set formula=IF(L2="","",0-(TODAY()-L2)) for H2:H65536?
or
the "H" column in worksheets 11,12, and 13 to have a set formula=IF(H2="","",0-(TODAY()-H2)) for H2:H65536?

And if the latter it still doesn't make sense to process the particular cell unless H2 is based off H1 along the lines of

the "H" column in worksheets 11,12, and 13 to have a set formula=IF(H1="","",0-(TODAY()-H1)) for H2:H65536?



Chris
0
 

Author Comment

by:nelsonje
ID: 22889820
I need H2: H65536 to have the foluma so it will give me a count of the date difference of column L and todays date, I need to set column H to this formula in these worksheets
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22892589
In that case it sounds like:

the "H" column in worksheets 11,12, and 13 to have a set formula=IF(L2="","",0-(TODAY()-L2)) for H2:H65536

Chris
Public Function HuntingtonAG()
 
 
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheets
Dim MyMonth As String
Dim MyDay As String
Dim MyYear As String
Dim MyTime As String
Dim path As String
Dim MyExtension As String
Dim MyFileName As String
Dim FileFormat As String
Dim Password As String
Dim WriteResPassword As String
Dim ReadOnlyRecommended As String
Dim CreateBackup As String
 
 
Dim rs As Recordset
Dim db As Database
 
Set db = CurrentDb
 
Mydirectory = "\\Tvhviruser.v09.med.va.gov\tvhpublic\MCCR\AR Weekly Report Database\581-Station Weekly Report Database\Weekly Report.xls"
MyNewFile = "\\Tvhviruser.v09.med.va.gov\tvhpublic\MCCR\581-Station Weekly Report\A-G\"
NewFilename = "Weekly Report "
MyMonth = Format(Now, "mm")
MyDay = Format(Now, "dd")
MyYear = Format(Now, "yyyy")
MyTime = Format(Time, "hh.mm.ss")
FileFormat = ".xls"
Password = ""
WriteResPassword = ""
ReadOnlyRecommended = False
CreateBackup = False
MyFileName = MyNewFile + NewFilename + MyMonth + MyDay + MyYear + MyTime + FileFormat
 
Set xlApp = CreateObject("Excel.Application")
Set wb = xlApp.Workbooks.Open(Mydirectory)
 
 
   Do Until wb.Worksheets.Count = 13
   wb.Worksheets.Add
Loop
 
Set rs = db.OpenRecordset("581 (A-G) 0-30 Days")
 
wb.Worksheets(1).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 31-60 Days")
 
wb.Worksheets(2).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 61-90 Days")
 
wb.Worksheets(3).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 91-120 Days")
 
wb.Worksheets(4).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 121-180 Days")
 
wb.Worksheets(5).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 181-365 Days")
 
wb.Worksheets(6).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) Over 365 Days")
 
wb.Worksheets(7).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) Payment/Resid")
 
wb.Worksheets(9).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) Master")
 
wb.Worksheets(10).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 1st Follow Up")
 
wb.Worksheets(11).Range("A2").CopyFromRecordset rs
wb.Worksheets(11).Range("H2:H65536").Formula = "=IF(L2="","",0-(TODAY()-L1))" 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 2nd Follow Up")
 
wb.Worksheets(12).Range("A2").CopyFromRecordset rs
wb.Worksheets(12).Range("H2:H65536").Formula = "=IF(L2="","",0-(TODAY()-L1))" 
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 3rd Follow Up")
 
wb.Worksheets(13).Range("A2").CopyFromRecordset rs
wb.Worksheets(13).Range("H2:H65536").Formula = "=IF(L2="","",0-(TODAY()-L1))" 
 
Set rs = Nothing
 
 
wb.SaveAs MyFileName
  
'Close Excel
wb.Close savechanges:=False
xlApp.Quit
Set xlApp = Nothing
Set wb = Nothing
Set ws = Nothing
 
End Function

Open in new window

0
 

Author Comment

by:nelsonje
ID: 22895880
This is kinda working the only problem is when it sets the formula in excel column it is dropping some of the information in the folrmula

GOOD:
Example:=IF(N2="","",0-(TODAY()-N2))

BAD
Example:=IF(N2=",",0-(TODAY()-N2))

do you know how to fix this?
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 22897881
Sorry didn't test thoroughly

See below

Chris
Public Function HuntingtonAG()
 
 
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheets
Dim MyMonth As String
Dim MyDay As String
Dim MyYear As String
Dim MyTime As String
Dim path As String
Dim MyExtension As String
Dim MyFileName As String
Dim FileFormat As String
Dim Password As String
Dim WriteResPassword As String
Dim ReadOnlyRecommended As String
Dim CreateBackup As String
 
 
Dim rs As Recordset
Dim db As Database
 
Set db = CurrentDb
 
Mydirectory = "\\Tvhviruser.v09.med.va.gov\tvhpublic\MCCR\AR Weekly Report Database\581-Station Weekly Report Database\Weekly Report.xls"
MyNewFile = "\\Tvhviruser.v09.med.va.gov\tvhpublic\MCCR\581-Station Weekly Report\A-G\"
NewFilename = "Weekly Report "
MyMonth = Format(Now, "mm")
MyDay = Format(Now, "dd")
MyYear = Format(Now, "yyyy")
MyTime = Format(Time, "hh.mm.ss")
FileFormat = ".xls"
Password = ""
WriteResPassword = ""
ReadOnlyRecommended = False
CreateBackup = False
MyFileName = MyNewFile + NewFilename + MyMonth + MyDay + MyYear + MyTime + FileFormat
 
Set xlApp = CreateObject("Excel.Application")
Set wb = xlApp.Workbooks.Open(Mydirectory)
 
 
   Do Until wb.Worksheets.Count = 13
   wb.Worksheets.Add
Loop
 
Set rs = db.OpenRecordset("581 (A-G) 0-30 Days")
 
wb.Worksheets(1).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 31-60 Days")
 
wb.Worksheets(2).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 61-90 Days")
 
wb.Worksheets(3).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 91-120 Days")
 
wb.Worksheets(4).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 121-180 Days")
 
wb.Worksheets(5).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 181-365 Days")
 
wb.Worksheets(6).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) Over 365 Days")
 
wb.Worksheets(7).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) Payment/Resid")
 
wb.Worksheets(9).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) Master")
 
wb.Worksheets(10).Range("A2").CopyFromRecordset rs
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 1st Follow Up")
 
wb.Worksheets(11).Range("A2").CopyFromRecordset rs
wb.Worksheets(11).Range("H2:H65536").Formula = "=IF(L2="""","""",0-(TODAY()-L1))" 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 2nd Follow Up")
 
wb.Worksheets(12).Range("A2").CopyFromRecordset rs
wb.Worksheets(12).Range("H2:H65536").Formula = "=IF(L2="""","""",0-(TODAY()-L1))" 
 
Set rs = Nothing
 
Set rs = db.OpenRecordset("581 (A-G) 3rd Follow Up")
 
wb.Worksheets(13).Range("A2").CopyFromRecordset rs
wb.Worksheets(13).Range("H2:H65536").Formula = "=IF(L2="""","""",0-(TODAY()-L1))" 
 
Set rs = Nothing
 
 
wb.SaveAs MyFileName
  
'Close Excel
wb.Close savechanges:=False
xlApp.Quit
Set xlApp = Nothing
Set wb = Nothing
Set ws = Nothing
 
End Function

Open in new window

0
 

Author Closing Comment

by:nelsonje
ID: 31513068
Great job, thanks
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22898695
Your welcome and thank you for the grade.

Chris
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

We live in a world of interfaces like the one in the title picture. VBA also allows to use interfaces which offers a lot of possibilities. This article describes how to use interfaces in VBA and how to work around their bugs.
Windows Explorer let you handle zip folders nearly as any other folder: Copy, move, change, and delete, etc. In VBA you can also handle normal files and folders, but zip folders takes a little more - and that you'll find here.
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…
Suggested Courses

578 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