Don't want to hard-code file name in macro

  • Thread starter Thread starter G. O'Grady
  • Start date Start date
G

G. O'Grady

I'm writing a basic macro to do following:
* Have a primary workbook that has a data tab used in a pivot in same
workbook which is where macro will be executed from
* Have a second workbook that has data that is copied and pasted onto
data tab in primary workbook
* After copying and pasting data from second to primary, want to close
the second workbook and leave cursor on updated pivot tab in primary
workbook

3 questions:
1. Macro is good from standpoint of allowing user to browse and
select file and open copy copy data but fails in that the next line of
code is: Windows ("actualfilename.xlsm"). activate ... The minute
this file is saved as anything else, the macro will fail as the name
will be different than what is stored. How can I make the macro
flexible?

2. The other place where I need help is in closing the second
workbook. I had already used filename when allowing user to browse
and select the file. So I was hoping that is stored and thus
something I could use in my code. It wasn't working so I removed but
am hoping someone can help me figure out how to incorporate.

3. The second file will have varying rows over time (first time I
executed, there were 37 rows) ... the second time, it was double
however the copy/paste only brought in the 37 rows. How can I make
sure copy is always of all info?

Below is the VBA as is right now if that helps...
Thanks to any advice
Gretchen

VBA CODE:
Sub GetARMSExport()
Application.ScreenUpdating = False
Dim Finfo As String
Dim FilterIndex As Integer
Dim title As String
Dim filename As Variant

'set up list of file filters
Finfo = "Text Files (*.txt),*.txt," & "Lotus Files (*.prn),*.prn,"
& "Comma Separted Files (*.csv),*.csv," & "ASCII Files (*.asc),*.asc,"
& "All Files (*.*),*.*"

'Display *.* by default
FilterIndex = 5

'Set the dalog box caption
title = "Select a File to Import"

'Get the filename
filename = Application.GetOpenFilename(Finfo, _
FilterIndex, title)

'Handle return info from dialog box
If filename = False Then
MsgBox "No file was selected."

Else
Workbooks.Open filename
Cells.Select
Selection.Copy
Windows("B2A_E2C Tool.fy2012 - revised draft unprotected - 021512
v4.xlsm"). _
Activate
Sheets("ARMS Detailed Scheduling Report").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("ARMS Summary Scheduled Hrs").Select
Application.CutCopyMode = False
ActiveSheet.PivotTables("PivotTable4").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable4").PivotCache.Refresh
Calculate
Range("A6").Select
Application.ScreenUpdating = True

End If
End Sub
 
Two suggestions right off the top of my head...

In Finfo:
Since you include 'All Files (*.*),*.*' then the others are pointless.

Workbook1:
Since this is the workbook that contains the code, you can use
'ThisWorkbook' in code to get an absolute ref to it regardless of its
name.

Pivot Table sheet:
If you implement a special codename for this sheet you can use it
instead of the tab name in case the tab name gets changed. For example,
select the sheet in the VBE Project Explorer window and rename its
'(Name)' property at the top of the Properties list to "wksPivotTable".
Now use this name in your code instead of its tab name...

ThisWorkbook.Sheets(Get_SheetTabName(ThisWorkbook, "wksPivotTable"))

...which calls the following reusable function that returns the tab name
based on the sheet's codename.

Function Get_SheetTabName(Wkb As Workbook, CodeName As String) As
String
Dim Wks As Worksheet
For Each Wks In Wkb.Worksheets
If Wks.CodeName = CodeName Then Get_SheetTabName = Wks.name: Exit
Function
Next
End Function

--

Other suggestions...

I find it helpful to use absolute object refs for workbooks/worksheets.
For example...

Dim wksTarget As Worksheet
Set wksTarget = ThisWorkbook.Sheets(Get_SheetTabName(ThisWorkbook,
"wksPivotTable"))

...then in code I can simply ref that sheet as follows...

wksTarget.Range("A1")

So, in your workbook that contains the code...

Rename Sheets("ARMS Detailed Scheduling Report").CodeName to
"wksDetails"

Rename Sheets("ARMS Summary Scheduled Hrs").CodeName to
"wksSummary"

...then try this code...

Sub GetARMSExport2()
Dim bEventsEnabled As Boolean
Dim vFilename As Variant, vCalcMode As Variant
Dim wksTarget As Worksheet, wkbSource As Workbook

'Dialog parameters
Const sFinfo As String = "All Files (*.*),*.*"
Const sTitle As String = "Select a File to Import"

'Get the vFilename
vFilename = Application.GetOpenvFilename(sFinfo, , sTitle)
'If user cancels
If vFilename = False Then MsgBox "No file was selected.": Exit Sub

With Application
vCalcMode = .Calculation: bEventsEnabled = .EnableEvents
.Calculation = xlCalculationManual: .EnableEvents = False
.ScreenUpdating = False
End With 'Application

Set wksTarget = ThisWorkbook.Sheets(Get_SheetTabName(ThisWorkbook,
"wksDetails"))
Set wkbSource = Workbooks.Open(vFilename)
ActiveSheet.UsedRange.Copy Destination:=wksTarget.Range("A1")
Application.CutCopyMode = False
' wksTarget.Range("A1").Select '..if necessary

Set wksTarget = ThisWorkbook.Sheets(Get_SheetTabName(ThisWorkbook,
"wksSummary"))
With wksTarget
With .PivotTables("PivotTable4").PivotCache: .Refresh: .Refresh:
End With
.Range("A6").Select
End With 'wksTarget

'Destroy unused objects
Set wksTarget = Nothing: Set wkbSource = Nothing

'Cleanup
With Application
.Calculation = vCalcMode: .EnableEvents = bEventsEnabled:
..ScreenUpdating = False
End With 'Application
End Sub

(watch for line wraps)

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
I've added an error handler in case something goes wrong...

Sub GetARMSExport2()
Dim bEventsEnabled As Boolean
Dim vFilename As Variant, vCalcMode As Variant
Dim wksTarget As Worksheet, wkbSource As Workbook

'Dialog parameters
Const sFinfo As String = "All Files (*.*),*.*"
Const sTitle As String = "Select a File to Import"

'Get the vFilename
vFilename = Application.GetOpenvFilename(sFinfo, , sTitle)
'If user cancels
If vFilename = False Then MsgBox "No file was selected.": Exit Sub

With Application
vCalcMode = .Calculation: bEventsEnabled = .EnableEvents
.Calculation = xlCalculationManual: .EnableEvents = False
.ScreenUpdating = False
End With 'Application

On Error GoTo ErrExit
Set wksTarget = ThisWorkbook.Sheets(Get_SheetTabName(ThisWorkbook,
"wksDetails"))
Set wkbSource = Workbooks.Open(vFilename)
ActiveSheet.UsedRange.Copy Destination:=wksTarget.Range("A1")
Application.CutCopyMode = False
' wksTarget.Range("A1").Select '..if necessary

Set wksTarget = ThisWorkbook.Sheets(Get_SheetTabName(ThisWorkbook,
"wksSummary"))
With wksTarget
With .PivotTables("PivotTable4").PivotCache: .Refresh: .Refresh:
End With
.Range("A6").Select
End With 'wksTarget


ErrExit:
'Destroy unused objects
Set wksTarget = Nothing: Set wkbSource = Nothing

'Cleanup
With Application
.Calculation = vCalcMode: .EnableEvents = bEventsEnabled:
..ScreenUpdating = False
End With 'Application
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
GS also forgot to edit a copy/paste in the 'Cleanup block of code...
I've added an error handler in case something goes wrong...

Sub GetARMSExport2()
Dim bEventsEnabled As Boolean
Dim vFilename As Variant, vCalcMode As Variant
Dim wksTarget As Worksheet, wkbSource As Workbook

'Dialog parameters
Const sFinfo As String = "All Files (*.*),*.*"
Const sTitle As String = "Select a File to Import"

'Get the vFilename
vFilename = Application.GetOpenvFilename(sFinfo, , sTitle)
'If user cancels
If vFilename = False Then MsgBox "No file was selected.": Exit Sub

With Application
vCalcMode = .Calculation: bEventsEnabled = .EnableEvents
.Calculation = xlCalculationManual: .EnableEvents = False
.ScreenUpdating = False
End With 'Application

On Error GoTo ErrExit
Set wksTarget = ThisWorkbook.Sheets(Get_SheetTabName(ThisWorkbook,
"wksDetails"))
Set wkbSource = Workbooks.Open(vFilename)
ActiveSheet.UsedRange.Copy Destination:=wksTarget.Range("A1")
Application.CutCopyMode = False
' wksTarget.Range("A1").Select '..if necessary

Set wksTarget = ThisWorkbook.Sheets(Get_SheetTabName(ThisWorkbook,
"wksSummary"))
With wksTarget
With .PivotTables("PivotTable4").PivotCache: .Refresh: .Refresh: End With
.Range("A6").Select
End With 'wksTarget


ErrExit:
'Destroy unused objects
Set wksTarget = Nothing: Set wkbSource = Nothing

'Cleanup
With Application
Click to expand...
.Calculation = vCalcMode: .EnableEvents = bEventsEnabled:
..ScreenUpdating = True
End With 'Application
End Sub
Click to expand...

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Back
Top