Access VB code to add formula to excel worksheet

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

nelsonjeAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Chris BottomleySoftware Quality Lead EngineerCommented:
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
nelsonjeAuthor Commented:
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
Chris BottomleySoftware Quality Lead EngineerCommented:
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
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

nelsonjeAuthor Commented:
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
Chris BottomleySoftware Quality Lead EngineerCommented:
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
nelsonjeAuthor Commented:
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
Chris BottomleySoftware Quality Lead EngineerCommented:
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
nelsonjeAuthor Commented:
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
Chris BottomleySoftware Quality Lead EngineerCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
nelsonjeAuthor Commented:
Great job, thanks
0
Chris BottomleySoftware Quality Lead EngineerCommented:
Your welcome and thank you for the grade.

Chris
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.