Macro that workd in same file saved with different name

[Amber12]

I just start working with Macros and I chose to use it on a report that I create every week. The only thing is that every week I save it with a different name and chage the date. The macro works only if I edit and change the name of the worksheet. I am assuming there is an easier way to use the macro with different workbooks...Maybe is the way that I am saving it?

Please take in consideration that I am a biginer.

Thank you

[mike7952]

If would be helpfull to see the code. But somewhere in the code you have

Worksheets("SomeNameofSheet")

try

Activesheet

[Amber12]

I have

Windows("Week 09-06-12.xlsx").Activate
ActiveCell.Select

Shall I change Windows to Activesheet?

Thank you

[mike7952]

You can try this, but without knowing/seeing your whole code im just shooting blind. If this dosent work can you upload your code and or workbook?

ThisWorkbook.Activate

[Amber12]

I made the change and it didn't work

This is the code that I have, with the change:

Sub OTReportdoi()
'
' OTReportdoi Macro
'

'
    ActiveCell.Select
    ActiveCell.FormulaR1C1 = ""
    ActiveCell.Select
    Workbooks.Open Filename:="C:\DMPS\61955cb_2.xls"
    Sheets("61955cb_2").Select
    ThisWorkbook.Activate
    ActiveCell.Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5>=4000),--('[61955cb_2.xls]61955cb_2'!C5<=4037),--('[61955cb_2.xls]61955cb_2'!C12<>0))"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5>=4000),--('[61955cb_2.xls]61955cb_2'!C5<=4037),'[61955cb_2.xls]61955cb_2'!C11)"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5>=4000),--('[61955cb_2.xls]61955cb_2'!C5<=4037),'[61955cb_2.xls]61955cb_2'!C12)"
    ActiveCell.Offset(0, -2).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1:C4").Select
    ActiveSheet.Paste
    ActiveCell.Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5>=5010),--('[61955cb_2.xls]61955cb_2'!C5<=5016),--('[61955cb_2.xls]61955cb_2'!C12<>0))"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5>=5010),--('[61955cb_2.xls]61955cb_2'!C5<=5016),'[61955cb_2.xls]61955cb_2'!C11)"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5>=5010),--('[61955cb_2.xls]61955cb_2'!C5<=5016),'[61955cb_2.xls]61955cb_2'!C12)"
    ActiveCell.Offset(1, -2).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5=5000),--('[61955cb_2.xls]61955cb_2'!C12<>0))"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5=5000),'[61955cb_2.xls]61955cb_2'!C11)"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5=5000),'[61955cb_2.xls]61955cb_2'!C12)"
    ActiveCell.Offset(1, -2).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5>=5020),--('[61955cb_2.xls]61955cb_2'!C5<=5022),--('[61955cb_2.xls]61955cb_2'!C12<>0))"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5>=5020),--('[61955cb_2.xls]61955cb_2'!C5<=5022),'[61955cb_2.xls]61955cb_2'!C11)"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5>=5020),--('[61955cb_2.xls]61955cb_2'!C5<=5022),'[61955cb_2.xls]61955cb_2'!C12)"
    ActiveCell.Offset(1, -2).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5>=5030),--('[61955cb_2.xls]61955cb_2'!C5<=5032),--('[61955cb_2.xls]61955cb_2'!C12<>0))"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5>=5030),--('[61955cb_2.xls]61955cb_2'!C5<=5032),'[61955cb_2.xls]61955cb_2'!C11)"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5>=5030),--('[61955cb_2.xls]61955cb_2'!C5<=5032),'[61955cb_2.xls]61955cb_2'!C12)"
    ActiveCell.Offset(-4, -2).Range("A1:C5").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveCell.Offset(5, 9).Range("A1").Select
End Sub

[mike7952]

What line is giving the error? Better yet If you like tell exactly what your doing and I can clean up the code? Are you really wanting formulas in the sheet? Is C:\DMPS\61955cb_2.xls the file you want to open everytime? Can you upload the workbook file with the macro and the 61955cb_2.xls so I can see an test. If its sensitive data just replace with dummy data but leave the data structure the same. Ex: Headers sheet names.

[Amber12]

Yes, the C:\DMPS\61955cb_2.xls is the file that I will always open. Is a download that will always over overwrite. I am attaching this file and I am also attaching the altered report where I bring the information in. I mainly have to count how many heads have overtime, how many hours and the value, per 5 categories. The macro would work fine IF I always edit the name of the worksheet I am working in. And every week is saved under a different date. So I would like to learn how to build up macros that I can use in a spreadsheet, no matter what the name is. I do the same reports weekly, but I save them under different names all the time. I would like to solve this issue because it’s something that affects ALL the macros I build for all other reports.

Thank you

61955cb_2.xls
Week 09-08-12.xlsx

[mike7952]

Im a little lost as to exactly what to happen. The reason is, the start of your Code? Activecell.select, workbookopen sheets select week workbook active activecell select. So its had to know whats going on Is there a certain cell that you click on before running the macro? Is there a sheet I need to be on before running the macro? If you can tell me What Im to look for in C:\DMPS\61955cb_2.xls. Ex: What Columns. Then where is the results to be place at in the Week workbook. Ex: What column what rows What sheets?

    ActiveCell.Select
    ActiveCell.FormulaR1C1 = ""
    ActiveCell.Select
    Workbooks.Open Filename:="C:\Users\Mike\Desktop\61955cb_2.xls"
    Sheets("61955cb_2").Select
    Windows("Week 09-06-12.xlsx").Activate
    ActiveCell.Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT(--('[61955cb_2.xls]61955cb_2'!C5>=4000),--('[61955cb_2.xls]61955cb_2'!C5<=4037),--('[61955cb_2.xls]61955cb_2'!C12<>0))"
    ActiveCell.Offset(0, 1).Range("A1").Select

[mike7952]

If you put in detail the steps you if you were to do this manually. Like sum up what column if .... And put that total where?

[Amber12]

What I need to do and how I am doing it is part of this thread: http://www.excelforum.com/excel-form...criterias.html

[Amber12]

When I run the macro I am supposed to be already in the spreadsheet, select the cell where I start bring the information (in my case tab 3 of 'Week 09-08-12', cell L46). Then the macro is opening the other file and stops because doesn't recognize where to bring the info, since the workbook is saved under a different name. If I change that name, then the data is being calculated and is populating my little table.

My criterias are on Column E and needs to total values on columns K and L and to count the values on L, according to the formulas used (SUMPRODUCT). Not sure if I make myself clear and what other information is needed.

Overall, I need to know how can I create a macro that I can use in workbooks saved under different names.

[mike7952]

Ok those 3 values, where do they go in the Week worksheet?

[Amber12]

L46 is a count of employees that did OT coded between 4000 and 4037, M46 is the hours of OT for the same category and N46 is the amount of money. L47:N47 is the same thing for those coded 5010-5016, L48:N48 is for those coded 5000, L49:N49 is for 5020-5022 and L50:N50 is for 5030-5032.

[mike7952]

@Amber

See if this helps. Sorry took so long I'v been busy all day. I fixed up your code some. Also included a function to check if the workbook is already opened. If it is then we will leave it open if not we close it after were done with it. See attachment Ver1

Sub OTReportdoi()
 Const sPath As String = "C:\DMPS\"                '<==== Change if needed to path of wb. Include \ at the end
 Const sFileName As String = "61955cb_2.xls"       '<==== Name of the wb we want to work with
 Const shSource As String = "61955cb_2"            '<==== Change to Source sheet name
 Const EDept_1 As String = "E:E"                   '<==== If any columns change just change here.
 Const OT_H As String = "K:K"                      '<
 Const OT_E As String = "L:L"                      '<
 Const shDest As String = "3"                      '<==== Change to the sheet name that we want the data togo to.
 Dim wbDest As Workbook
 Dim wbOpen As Boolean
 Dim strFormula As String                          '<== if the file name or sheet name changes
                                                   ' in source wb we change it once. So we dont have to mess with all the formulas.
    
    
                                                          
    Set wbDest = ThisWorkbook
    
    wbOpen = isWorkbookOpen(sFileName)
    
    On Error GoTo EarlyExit
    Application.ScreenUpdating = False
    If Not wbOpen Then
        Set wb = Workbooks.Open(sPath & sFileName) '<=== Workbook not open. do our thing and close it at the bottom of code.
    End If
    
    strFormula = "'[" & sFileName & "]" & shSource & "'!"
    With wbDest.Worksheets(shDest)
        .Range("L46:N50").ClearContents
        
        .Range("L46") = Evaluate("=SUMPRODUCT(--(" & strFormula & EDept_1 & ">=4000),--(" & strFormula & EDept_1 & "<=4037),--(" & strFormula & OT_E & "<>0))")
        .Range("M46") = Evaluate("=SUMPRODUCT(--(" & strFormula & EDept_1 & ">=4000),--(" & strFormula & EDept_1 & "<=4037)," & strFormula & OT_H & ")")
        .Range("N46") = Evaluate("=SUMPRODUCT(--(" & strFormula & EDept_1 & ">=4000),--(" & strFormula & EDept_1 & "<=4037)," & strFormula & OT_E & ")")
        
        .Range("L47") = Evaluate("=SUMPRODUCT(--(" & strFormula & EDept_1 & ">=5010),--(" & strFormula & EDept_1 & "<=5016),--(" & strFormula & OT_E & "<>0))")
        .Range("M47") = Evaluate("=SUMPRODUCT(--(" & strFormula & EDept_1 & ">=5010),--(" & strFormula & EDept_1 & "<=5016)," & strFormula & OT_H & ")")
        .Range("N47") = Evaluate("=SUMPRODUCT(--(" & strFormula & EDept_1 & ">=5010),--(" & strFormula & EDept_1 & "<=5016)," & strFormula & OT_E & ")")
        
        .Range("L48") = Evaluate("=SUMPRODUCT(--(" & strFormula & EDept_1 & "=5000),--(" & strFormula & OT_E & "<>0))")
        .Range("M48") = Evaluate("=SUMPRODUCT(--(" & strFormula & EDept_1 & "=5000)," & strFormula & OT_H & ")")
        .Range("N48") = Evaluate("=SUMPRODUCT(--(" & strFormula & EDept_1 & "=5000)," & strFormula & OT_E & ")")
        
        .Range("L49") = Evaluate("=SUMPRODUCT(--(" & strFormula & EDept_1 & ">=5020),--(" & strFormula & EDept_1 & "<=5022),--(" & strFormula & OT_E & "<>0))")
        .Range("M49") = Evaluate("=SUMPRODUCT(--(" & strFormula & EDept_1 & ">=5020),--(" & strFormula & EDept_1 & "<=5022)," & strFormula & OT_H & ")")
        .Range("N49") = Evaluate("=SUMPRODUCT(--(" & strFormula & EDept_1 & ">=5020),--(" & strFormula & EDept_1 & "<=5022)," & strFormula & OT_E & ")")
    
        .Range("L50") = Evaluate("=SUMPRODUCT(--(" & strFormula & EDept_1 & ">=5030),--(" & strFormula & EDept_1 & "<=5032),--(" & strFormula & OT_E & "<>0))")
        .Range("M50") = Evaluate("=SUMPRODUCT(--(" & strFormula & EDept_1 & ">=5030),--(" & strFormula & EDept_1 & "<=5032)," & strFormula & OT_H & ")")
        .Range("N50") = Evaluate("=SUMPRODUCT(--(" & strFormula & EDept_1 & ">=5030),--(" & strFormula & EDept_1 & "<=5032)," & strFormula & OT_E & ")")
    End With
    
EarlyExit:
    ' If we opened wb then close it if not leave it open
    If Not wbOpen Then
        wb.Close
    End If
    Application.ScreenUpdating = True
    Set wbDest = Nothing
    Set wb = Nothing
    ' Check if there were ant errors
    If Err.Number <> 0 Then
        MsgBox "Error #: " & Err.Number & vbCrLf & "Description: " & Err.Description, vbInformation, "Error"
    End If
End Sub

Private Function isWorkbookOpen(bookName As String) As Boolean
 Dim vbResult As Boolean
 Dim wbs As Workbook
 vbResult = False
 
    For Each wbs In Workbooks
        If UCase(wbs.Name) = UCase(bookName) Then
            vbResult = True
          Exit For
        End If
    Next wbs
    isWorkbookOpen = vbResult
End Function

And heres another way. I like this way. It will query the sheet like a database. A lot faster. See attachment Ver2

Sub OTReportdoi_v2()
 Const sPath As String = "C:\DMPS\"  '<==== Change if needed to path of wb. Include \ at the end
 Const sFileName As String = "61955cb_2.xls"       '<==== Change if needed to Name of the wb we want to work with
 Const shSource As String = "61955cb_2"            '<==== Change if needed to Source sheet name
 Const shDest As String = "3"                      '<==== Change if needed to the sheet name that we want the data togo to.
 Const EDept_1 As String = "EDept_1"               '<==== If any Columns Headers names change, jus change them here.
 Const OT_H As String = "OT H"                     '<
 Const OT_E As String = "OT E"                     '<
 
 Const adStateOpen As Long = 1
 Const adOpenForwardOnly As Long = 1
 Const adLockReadOnly As Long = 1
 Dim oCnn As Object
 Dim oRs As Object
 Dim sSQL As String, sCnn As String, sDataSource As String
 Dim aSQL(0 To 4) As String, indx As Long
 


    With Worksheets(shDest)
        .Range("L46:N50").ClearContents
    End With
    
    sDataSource = sPath & sFileName
    sCnn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
    & sDataSource & ";Extended Properties=""Excel 8.0;HDR=YES"""

'   Create Connection Object
    Set oCnn = CreateObject("ADODB.Connection")
'   Open Created Connection
    On Error Resume Next
    oCnn.Open sCnn
'   Check Connection State.
    If oCnn.State <> adStateOpen Then
        MsgBox "File Not found: " & vbCrLf & oCnn.ConnectionString, vbCritical
        Exit Sub
    End If
    On Error GoTo 0

'   Assign aSQL with our 5 query Category

'   Blanking
    aSQL(0) = "SELECT Count([" & OT_E & "]) AS Count_OT, Sum([" & OT_H & "]) AS Sum_OT_H, Sum([" & OT_E & "]) AS SumOT_E " & _
              "FROM [" & shSource & "$] " & _
              "WHERE ((([" & EDept_1 & "])>=4000 And ([" & EDept_1 & "])<=4037) AND (([" & OT_E & "])<>0));"
'   Maintenance
    aSQL(1) = "SELECT Count([" & OT_E & "]) AS Count_OT, Sum([" & OT_H & "]) AS Sum_OT_H, Sum([" & OT_E & "]) AS SumOT_E " & _
              "FROM [" & shSource & "$] " & _
              "WHERE ((([" & EDept_1 & "])>=5010 And ([" & EDept_1 & "])<=5016) AND (([" & OT_E & "])<>0));"
'   Supervisors
    aSQL(2) = "SELECT Count([" & OT_E & "]) AS Count_OT, Sum([" & OT_H & "]) AS Sum_OT_H, Sum([" & OT_E & "]) AS SumOT_E " & _
              "FROM [" & shSource & "$] " & _
              "WHERE ((([" & EDept_1 & "])=5000) AND (([" & OT_E & "])<>0));"
'   Quality
    aSQL(3) = "SELECT Count([" & OT_E & "]) AS Count_OT, Sum([" & OT_H & "]) AS Sum_OT_H, Sum([" & OT_E & "]) AS SumOT_E " & _
              "FROM [" & shSource & "$] " & _
              "WHERE ((([" & EDept_1 & "])>=5020 And ([" & EDept_1 & "])<=5022) AND (([" & OT_E & "])<>0));"
'   Office
    aSQL(4) = "SELECT Count([" & OT_E & "]) AS Count_OT, Sum([" & OT_H & "]) AS Sum_OT_H, Sum([" & OT_E & "]) AS SumOT_E " & _
              "FROM [" & shSource & "$] " & _
              "WHERE ((([" & EDept_1 & "])>=5030 And ([" & EDept_1 & "])<=5032) AND (([" & OT_E & "])<>0));"
    
'   Loop tru aSQL with our 5 query Category
    For indx = LBound(aSQL) To UBound(aSQL)
        sSQL = aSQL(indx)
        
        Set oRs = CreateObject("ADODB.Recordset")
'       Open Created Recordset
        On Error Resume Next
        oRs.Open sSQL, oCnn, adOpenForwardOnly, adLockReadOnly
        If oRs.State <> adStateOpen Then
            MsgBox Err.Description
            oCnn.Close
            Set oCnn = Nothing
            Exit Sub
        End If
        On Error GoTo 0
    
        If Not oRs.EOF Then
'           Add values
            With ThisWorkbook.Worksheets(shDest)
                .Cells(46, "L").Offset(indx).Resize(, 3).CopyFromRecordset oRs
            End With
        End If
'       Close Recordset
        oRs.Close
        Set oRs = Nothing
    Next
'   Close Connecton
    oCnn.Close
    Set oCnn = Nothing

You can run the macros by clicking on your little man with the hard hat.
Ver1.xlsm
Ver2.xlsm

[Amber12]

Sorry I answer late as well.
With the first version I get a message: Error#: 9 Description: Subscription out of range.
With the second version it gives me an error and highlight in yellow this row: With ThisWorkbook.Worksheets(shDest)

If Not oRs.EOF Then
'           Add values
            With ThisWorkbook.Worksheets(shDest)
                .Cells(46, "l").Offset(indx).Resize(, 3) = Application.Transpose(oRs.GetRows)
            End With
        End If
'       Close Recordset
        oRs.Close
        Set oRs = Nothing

I don't know how to fix these and where the problem is.

As a rule (if there is such a thing) how can I save a macro to work in any file, no matter the name is saved under? Is that something I have to add in code? Is it the way I save it? I want to be able to build by myself, recording, any macro and be able to use it, even if I change the name of the file.

Thank you

[mike7952]

where are you saving the Macro? What is the name of the sheet that we want to add the totals to?

Edit: shDest is a Const at the top of both codes. shDest = "3". change 3 to the sheet name in your actual file.