VBA to call the current workbook 2

[mpm32]

I have a workbook where at the end of each month it is saved as the next month. For example this month I have 01-Jan SGA.xls next month I will save this as 02-Feb SGA.xls.

I made this macro that will take some of the sheets, copy them into a new workbook, name the new workbook and then copy the values over onto the new sheet. This works fine - this month, in the code it references the 01-Jan.xls file. Next month when I run the macro it will be from the 02-Feb SGA.xls file.

How do I write the code to call the sheets regardless what the file name is?

I would also like to have the new workbook be named "AR 01-Jan SGA.xls" or whatever the month is. Is there a way to do that as well?

Here's the code

Sub ARsheetCreation()
'
' ARsheetCreation Macro
'

'
    Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
        "TotalARBilling.T")).Select
    Sheets("TotalARBilling.T").Activate
    Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
        "TotalARBilling.T")).Copy
    ActiveWorkbook.SaveAs Filename:="C:\AR SGA.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    Windows("01-Jan SGA.xls").Activate
    Range("B9:S58").Select
    Selection.Copy
    Windows("AR SGA.xls").Activate
    Range("B9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    ActiveWorkbook.Save
    ActiveWindow.Close
End Sub

 

[Gavona]

I made sure that the cell that RptDte is stored is formatted as text

dte As Date

I would have thought that you need dte As [r]String[/r].
Dates are not strings.

Gavin

 

[SkipVought]

what about...

  wbNEW.SaveAs Filename:="C:\AR [b]" & Format(dte, "mm-mmm") & "[/b]SGA.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False

as I had before when it was a DATE and not a string???

Curious, why when you first copy the array of sheets to a new workbook, that the values in B9:S58 did not appear on each sheet??? Why this extra COPY/PASTE step?




Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mpm32]

When I copy the sheets into the new book, I have numerous cells that use this formula (which you helped me with) - =SUMPRODUCT((INDIRECT($A$3&"!$D$5:$O$5")<=$A$7)*(INDIRECT($A$3&"!D11:O11"))) I get #REF errors on the pasted sheets.

I also want to eliminate the formulas on the pasted sheets.

Is there a way to copy those sheets into the new workbook pasting only formats and values? Eliminating the extra step?

I changed the code as you suggested - the named range RptDte is in the format mm-mmm, I still get a type mismatch error.

ub ARsheetCreation()
'
' ARsheetCreation Macro
'

'
   Dim wbNEW As Workbook, dte As Date
   
    Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
        "TotalARBilling.T")).Copy
   
   [COLOR=red yellow]dte = [RptDte][/color]
   
   Set wbNEW = ActiveWorkbook

    wbNEW.SaveAs Filename:="C:\AR " & Format(dte, "mm-mmm") & "SGA.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
        
    ThisWorkbook.Worksheets("7210544.T").Range("B9:S58").Copy
    
    With wbNEW
        .ActiveSheet.Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        .Save
        .Close
    End With
End Sub

 

[SkipVought]

Use some code like this...

dim ws as worksheet, wsNEW as worksheet

for each ws in thisworkbook.worksheets
  with ws
     select case .name
        case "7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", "TotalARBilling.T"
           .Range("B9:S58").Copy
        
           for each wsnew in wbNew.worksheets
              if .name = wsnew.name then
                 wsnew.[b9].pastespecial xlpastevalues
              end if
           next

     end select
  end with
next

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mpm32]

Ok, this works nicely. However, I can not get it to use the value in the named range RptDte. I still get a type mismatch error. I have tried formatting the cell RptDate as Date, Text, General, mm-mmm, Number, nothing works.

In the watch window I get; Watch : : dte = [RptDte] : <Out of context> : Variant/Empty : Module4.ARsheetCreation

Also, where would I put the .Save and .Close

ub ARsheetCreation()
'
' ARsheetCreation Macro
'

'
Dim wbNEW As Workbook, dte As Date
   
    Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
        "TotalARBilling.T")).Copy
   
   dte = "01-Jan"
   
   Set wbNEW = ActiveWorkbook

    wbNEW.SaveAs Filename:="C:\AR " & Format(dte, "mm-mmm") & " SGA.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    
    Dim ws As Worksheet, wsNEW As Worksheet

For Each ws In ThisWorkbook.Worksheets
  With ws
     Select Case .Name
        Case "7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", "TotalARBilling.T"
           .Range("B9:S58").Copy
        
           For Each wsNEW In wbNEW.Worksheets
              If .Name = wsNEW.Name Then
                 wsNEW.[b9].PasteSpecial xlPasteValues
              End If
           Next

     End Select
  End With
  
 
Next


End Sub

 

[SkipVought]

after for...next loop

 wbnew.save
 wbnew.close

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SkipVought]

In the watch window I get; Watch : : dte = [RptDte] : <Out of context> : Variant/Empty : Module4.ARsheetCreation

You must be executing code in the same procedure that you added the watch. Your message indicates that you are NOT.


Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mpm32]

Thanks, still getting Type mismatch with the named range. In the immediate window I get this for the range;

? Range("RptDte")
1/31/2011

I tried removing the brackets and using quotes "RptDte" and I get a runtime error, script out of range. Argh....

Sub ARsheetCreation()
'
' ARsheetCreation Macro
'

'
Dim wbNEW As Workbook, dte As Date
   
    Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
        "TotalARBilling.T")).Copy
   
   [COLOR=red yellow]dte = [RptDte][/color]
   
   Set wbNEW = ActiveWorkbook

    wbNEW.SaveAs Filename:="C:\AR " & Format(dte, "mm-mmm") & " SGA.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    
    Dim ws As Worksheet, wsNEW As Worksheet

For Each ws In ThisWorkbook.Worksheets
  With ws
     Select Case .Name
        Case "7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", "TotalARBilling.T"
           .Range("B9:S58").Copy
        
           For Each wsNEW In wbNEW.Worksheets
              If .Name = wsNEW.Name Then
                 wsNEW.[b9].PasteSpecial xlPasteValues
              End If
           Next

     End Select
  End With
  
 
Next

 wbNEW.Save
 wbNEW.Close

End Sub

 

[SkipVought]

well then use

   dte = Range("RptDte")

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Gavona]

Even what Skip posted will assume that the range is in the active workbook and either a workbook level named range or a sheetlevel named range in the active worksheet. From what you posed about the immediate Window that would appear to be OK in this instance.
However, it does no harm to be more explicit specifying the workbook and worksheet that the range is in. Something like:

ThisWorkbook.Sheets(1).Range("RptDte")

Gavin

 

[mpm32]

dte = Range("RptDte")

returns Run-time error '1004': Method 'Range' of object '_Global' failed.

I tried

dte = ThisWorkbook.Sheets(1).Range("RptDte")

returns Run-time error '1004': Application-defined or object-defined error

I then thought I needed to use Set so I tried

Set dte = ThisWorkbook.Sheets(1).Range("RptDte")

and I get compile error object required.

Another interesting thing ?Range("RtpDte") in the immediate window doesn't return the value in that named cell when another workbook is open.

Could any of these problems be caused by incorrect references selected? When I have trouble with VB in access, sometimes it's caused by the wrong references selected. Could I be missing something?

I have the following checked;

Visual Basic For Applications
Microsoft Excel 11.0 object Library
OLE Automation
Microsoft Office 11.0 object Library
Microsoft Forms 2.0 object Library

 

[mpm32]

OK, I figured it out! This works;

Dim wbNEW As Workbook, dte As Date
   
    Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
        "TotalARBilling.T")).Copy
   
   dte = ThisWorkbook.Sheets("Tools").Range("RptDte")
   
   Set wbNEW = ActiveWorkbook

    wbNEW.SaveAs Filename:="C:\AR " & Format(dte, "mm-mmm") & " SGA.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    
    Dim ws As Worksheet, wsNEW As Worksheet

For Each ws In ThisWorkbook.Worksheets
  With ws
     Select Case .Name
        Case "7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", "TotalARBilling.T"
           .Range("B9:S58").Copy
        
           For Each wsNEW In wbNEW.Worksheets
              If .Name = wsNEW.Name Then
                 wsNEW.[b9].PasteSpecial xlPasteValues
              End If
           Next

     End Select
  End With
  
 
Next

 wbNEW.Save
 wbNEW.Close

End Sub

Thanks for all of your help, I have learned a lot. Now I need to write the same code a bunch more times to chop up the rest of the workbook. And then I have to figure out how to email them out to the appropriate individuals. Off to research, thanks again for your help.

 

[SkipVought]

Now I need to write the same code a bunch more times ...

Each time you COPY code and replicate with "theme & variations in F-sharp minor", you stand the chanc of multiplying your woes, come a change to the process.

Try to think in terms of putting the variation(s) either within the current process or as another procedure that gets called within the current process. Often as you analyse your code, you can find commonality that, 1) keep your code from becoming voluminous and 2) makes it much simpler to understand and maintain.


Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mpm32]

Thanks Skip. So you would suggest that if I need to do this process a number of times for different groups of sheets, I should create a module for each and then create a module that calls each of them?

 

[SkipVought]

No. I meant that you should strive to accomplish all the same kind of thing in one procedure if at all possible. Definitely NOT the same kind of stuff in different modules!!!

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SkipVought]

For instance, rather than having a separate procedure for each copy/paste or duplicated code for mulriple copy/paste operations, we are using...

    Dim ws As Worksheet, wsNEW As Worksheet

For Each ws In ThisWorkbook.Worksheets
  With ws
     Select Case .Name
        Case "7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", "TotalARBilling.T"
           .Range("B9:S58").Copy
        
           For Each wsNEW In wbNEW.Worksheets
              If .Name = wsNEW.Name Then
                 wsNEW.[b9].PasteSpecial xlPasteValues
              End If
           Next

     End Select
  End With
  
 
Next

THIS is the kind of code you want to strive to produce.

Sometimes I'll be coding a complex process, and as I look at the code I am writing, I begin to see repeated patterns. So then I redesign the process to simplify and reuse code.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]