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

Excel Macro

Hi Experts,
I have an excel doc, with about 10 sheets. each sheets have 3 columns of datas .
First column is the Job# , the second is the Date Received, and the third is the Invoice Date.

What I am trying to accomplish is to get the networking days between the 2 dates( =networkdays formula) , So of course I know how to do it by going  to the first cell of a new column , type the formula and copy and paste the formula for the remaining of the column.
But I would like to create a macro that would do that for me for all the sheets.
Also the data comes from an Access Database which means that the excel spreadsheet gets overwriten everytime we run the query in ACCESS ( Access delete the Excel files and replace it with a new one) so I guess I need to save the Macro in a different Excel that will point to my data one.
Idealy would be to have one spreadsheet with my macro(let's call it macro.xls), that goes/read into the data excel(called Data.xls), copy everything into macro.xls , create me the new column and I just have to save it has a different name.
Hopefully m,y description is clear enought.
let me know if you need more info.

Thanks
David

0
taverny
Asked:
taverny
  • 8
  • 7
  • 3
2 Solutions
 
SiddharthRoutCommented:
David, Can you share a sample file so that I get my references correct?

Sid
0
 
hitsdoshi1Commented:
Hi David:

Here what you need...

First regarding access overwriting the excel files.....well you need to write a macro in personal.xls and run it from there....so basically it serves as template....you still have the code anytime you create a new file.....following are the instructions on how to create Personal.xls

http://office.microsoft.com/en-us/excel-help/deploy-your-excel-macros-from-a-central-file-HA001087296.aspx

Now calculating NetworkDays in all the worksheets

Assuming you are trying to find dates between column "B"(Date Received) & column "C" (Invoice Date)  and result of network days will be placed in column "D"

Place the following code in the personal.xls and when you are done exporting you can run this macro from excel or you can just directly reference from Access as well...(If you like to do this then let me know and I will send you code to paste in Access to run macro from excel)




Sub CalcNWDays()
 Dim wsSheet As Worksheet
 Dim mdate, ndate As Date
    For Each wsSheet In ActiveWorkbook.Worksheets
        For m = 1 To 65000
            mdate = Range("B" & m)
            ndate = Range("C" & m)
            If mdate = "" And ndate = "" Then
                Exit For
            End If
            Range("D" & m) = Application.Run("ATPVBAEN.XLA!Networkdays", mdate, ndate)
        Next
    Next
End Sub

Open in new window

0
 
tavernyAuthor Commented:
Thanks for the prompt response.
Sid, attached is the sample excel. hitsdoshi1 , I am gonna try your code. I don't need to run the code from Access.
I haven't look at the code yet, but if I understand correctly I need to save your code in a "template" excel and then open this template that will point to my new exported excel file? is that correct or do I have to copy it in the new exported excel everytime?
I will try it now thanks
Sample-File.xls
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!

 
hitsdoshi1Commented:
No, its works like template, when you open excel, code is always there.....so you don't need to copy or run it from other file. Just save the code in Personal.xls and after exporting your data just press F8 and you will see the macro CalNWDays

0
 
tavernyAuthor Commented:
ok , I guess I did something wrong.
I have Exel 2010 on my machine , but the machine that will run it is an excel 2007. So I opened a new excel I clicked F11 to run the VB , I copy and paste your code , I saved it as Personal.xlsm ( excel told me that I have to save it as macro otherwise the macro will not be saved) , then I close everything. put the personal.xlsm and my raw data "raw.xls" ( which is a excel 97-2003 file) on the desktop.
open my Raw.xls go to view>macro and then I choose the macro (Personal.xlsm!ThisWorkbook.CalcNWDays) and on the bottom where it says macros in I choose my Excel file ( rawdata.xls and click Run
then I get a type mismatch error.
What am I  missing?

Thanks
David
0
 
SiddharthRoutCommented:
David,  I can give you the code but there is a slight confusion. In your original post you mentioned that there are only 3 columns.

>>>First column is the Job# , the second is the Date Received, and the third is the Invoice Date.

But there are more than 3 columns and the Network days formula is referring to "Approved Date" in your file. Could you please clarify?

Sid
0
 
hitsdoshi1Commented:
Ok, I modified the code slightly as per your excel sample file. The problem is all the worksheet in the file should be formatted equally. Your first worksheet has column B & C with dates and fourth one has C & D with dates. Also make sure that column are formatted as date and not general or text.


Sub CalcNWDays()
 Dim wsSheet As Worksheet
 Dim mdate, ndate As Date
    For Each wsSheet In ActiveWorkbook.Worksheets
        For m = 2 To 65000
            mdate = Range("B" & m)
            ndate = Range("C" & m)
            Debug.Print m & " " & n
            If mdate = Null Or ndate = Null Then
                Exit For
            End If
            Range("D" & m) = Application.Run("ATPVBAEN.XLA!Networkdays", mdate, ndate)
        Next
    Next
End Sub

Open in new window

0
 
tavernyAuthor Commented:
ok sorry for the confusion. I just the query again and I am attaching the raw output from my access database , so it is exactly how I will get the file.and I do see it's not consistent with the column order. maybe if it's easier , I can have one macro running for each individual  sheet , if you show me how I can run for sheet 1 and sheet 4 I can modify the code to replicate for the rest of the sheet.
thanks  and sorry for the confusion again. but the attachment is really the output one.
RawData.xls
0
 
SiddharthRoutCommented:
>>>I do see it's not consistent with the column order. maybe if it's easier , I can have one macro running for each individual  sheet ,

No that is ok :) The code which I will give you will work for inconsistent columns as well. Please give me a short while :)

Sid
0
 
SiddharthRoutCommented:
Quick question.

How are you generating the column headers? via query or manually?

Sid
0
 
tavernyAuthor Commented:
thru the query
0
 
SiddharthRoutCommented:
ok.

Sid
0
 
SiddharthRoutCommented:
TRIED AND TESTED

The logic that I am following is that you are using 3 conditions to calculate the Networking days across worksheets, viz

1) RECEIVE DATE    QUOTE DATE
2) APPROVED DATE   INVOICE DATE
3) DATE RECEIVED   QUOTE DATE

So the code opens the Rawdata file and loops through each sheet finding the above combination and then uses the customized NETWORKDAYS formula.

This code will directly modify the Rawdata File. No need to import it into a new file.

Right now the code doesn't close the Rawdata file. If you feel the code is working correctly then un comment the last 3 lines. in the code below.

Sample file Attached.

Sid

Code Used

Option Explicit

'~~> Change the path of the file here
Const FilePath As String = "C:\Rawdata.xls"

Const HeaderText1a As String = "RECEIVE DATE"
Const HeaderText1b As String = "DATE RECEIVED"
Const HeaderText1c As String = "QUOTE DATE"

Const HeaderText2a As String = "APPROVED DATE"
Const HeaderText2b As String = "INVOICE DATE"

Const headerText As String = "NET WORK DAYS"

'~~> Three Combinations used to calculate Networking days
'RECEIVE DATE    Quote Date
'APPROVED DATE   INVOICE DATE
'DATE RECEIVED   QUOTE DATE

Private Sub CommandButton1_Click()
    Dim wb1 As Workbook
    Dim ws As Worksheet
    Dim LastRowWs As Long, c1 As Long, i As Long
    Dim Rng1 As Range, Rng2 As Range
    Dim Head1a As Boolean, Head1b As Boolean, Head1c As Boolean
    Dim Head2a As Boolean, Head2b As Boolean
    
    Set wb1 = Workbooks.Open(FilePath)
    
    For Each ws In wb1.Worksheets
        With ws
            Head1a = False: Head1b = False: Head1c = False
            Head2a = False: Head2b = False
            LastRowWs = .Range("A" & .Rows.Count).End(xlUp).Row
            c1 = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
            .Cells(1, c1) = headerText
            
            '~~> Check for HeaderText1a
            For i = 1 To c1 - 1
                If InStr(1, .Cells(1, i).Value, HeaderText1a, vbTextCompare) Then
                    Head1a = True
                    Set Rng1 = .Cells(1, i)
                    Exit For
                End If
            Next i
            
            '~~> Check for HeaderText1b
            For i = 1 To c1 - 1
                If InStr(1, .Cells(1, i).Value, HeaderText1b, vbTextCompare) Then
                    Head1b = True
                    Set Rng1 = .Cells(1, i)
                    Exit For
                End If
            Next i
            
            '~~> Check for HeaderText1c
            If Head1a = True Or Head1b = True Then
                For i = 1 To c1 - 1
                    If InStr(1, .Cells(1, i).Value, HeaderText1c, vbTextCompare) Then
                        Head1c = True
                        Set Rng2 = .Cells(1, i)
                        Exit For
                    End If
                Next i
            End If
            
            '~~> Check for HeaderText2a if the above is not found
            If Head1c = False Then
                For i = 1 To c1 - 1
                    If InStr(1, .Cells(1, i).Value, HeaderText2a, vbTextCompare) Then
                        Head2a = True
                        Set Rng1 = .Cells(1, i)
                        Exit For
                    End If
                 Next i
            End If
            
            '~~> Check for HeaderText2b
            If Head2a = True Then
                For i = 1 To c1 - 1
                    If InStr(1, .Cells(1, i).Value, HeaderText2b, vbTextCompare) Then
                        Head2a = True
                        Set Rng2 = .Cells(1, i)
                        Exit For
                    End If
                Next i
            End If
            
            Debug.Print ws.Name & ", " & Rng1.Address & ":" & Rng1.Value
            Debug.Print ws.Name & ", " & Rng2.Address & ":" & Rng2.Value
            
            .Cells(2, c1).Formula = "=ABS(NETWORKDAYS(" & Replace(Rng1.Offset(1).Address, "$", "") & _
                                    "," & _
                                    Replace(Rng2.Offset(1).Address, "$", "") & _
                                    "))"
            
            On Error Resume Next
            .Cells(2, c1).AutoFill Destination:=.Range(.Cells(2, c1).Address & ":" & .Cells(LastRowWs, c1).Address), Type:=xlFillDefault
            On Error GoTo 0
            .Cells.EntireColumn.AutoFit
        End With
    Next
'    wb1.Close savechanges = True
'    Set ws = Nothing
'    Set wb1 = Nothing
    MsgBox "Done"
End Sub

Open in new window


Hope this helps.

Sid
FormatRawData.xls
0
 
SiddharthRoutCommented:
I forgot to delete line 89 and 90 from the above code. Please delete that as I was using it for testing purpose only.

Sid
0
 
tavernyAuthor Commented:
I am gonna try it now. I will let you know .
Thanks
0
 
tavernyAuthor Commented:
Wow , it's awesome. it works perfectly .
Thank you so much. I actually have a part 2 of this problem.
I am gonna open a new question link to this one. just to give you the heads up , I would like to calculate the mode and median of this new column and placed at the bottom of this column, also I have another excell, where I record all the median and mode for all those sheets.
I am opening the question now , so yo can see a better explanation.
thanks again, great job
0
 
SiddharthRoutCommented:
Thanks. Glad to be of help :)

Sid
0
 
tavernyAuthor Commented:
I just posted my new questions.
thanks
0

Featured Post

New feature and membership benefit!

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

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