Excel Macro: Need to update Macro to point to new template.

GreenwoodJennifer

New Member
Joined
Mar 5, 2014
Messages
1
Hello :)
I am not well versed in VB Logic and am tring to update an existing macro to point to a new template. Below is the old macro, can someone tell me where I need to make the updates within the macro to get it to pull in the two new template worksheets. These two macros are related to eachother and I need to update them:


Sub OpenRateSheetTemplate()
Sub CopyRateSheet()
-------
Code:
Sub OpenRateSheetTemplate()

Dim xlApp As Excel.Application
Dim xlTemp As Excel.Workbook
Dim filename As String, fName As String, DirName As String
Dim newFileName As String, varSheet As Variant

varSheet = "HQ Summary"

'ThisWorkbook.Worksheets("Parameter_Constants").Visible = True

DirName = ThisWorkbook.Worksheets("Parameter_Constants").Range("PreRateSheet").Value
filename = ThisWorkbook.Worksheets("Parameter_Constants").Range("PreRateSheetTemplate").Value

Sheets(varSheet).Visible = True
Sheets(varSheet).Select

ThisWorkbook.Worksheets(varSheet).Range("OrderUnitNo").Select
' Check to see if the unit number field (E5) is blank if it is then exit procedure with a message
If (Trim(Range("OrderUnitNo").Value) <> "") And (Len(Trim(Range("OrderUnitNo").Value)) = 6) Then

newFileName = Trim(Range("OrderUnitNo").Value) & ".XLS"

Dim accum As Double
fName = DirName & newFileName

'If this file does not exist then build it and save it - otherwise give user a message
x = Dir(fName)
If Trim(x) = "" Then

x = ""
Set xlApp = New Excel.Application
I
'Open Rate Sheet Template
Set xlTemp = xlApp.Workbooks.Open(filename)
' Save the new workbook with the unitnumber
Select Case Application.Version
Case "11.0"
xlTemp.SaveAs filename:=fName, FileFormat:=56
Case "12.0"
xlTemp.SaveAs filename:=fName, FileFormat:=52
Case "14.0"
xlTemp.SaveAs filename:=fName, FileFormat:=52
End Select
xlApp.Visible = False

'Next transfer selected data to the newly created workbook.
Call WorkbookToRatesheetTransfer(xlTemp, ByVal varSheet, bIncludeActuals:=False)

'Save the Updated Rate Sheet and hand over to user
xlApp.UserControl = True
xlApp.Visible = True
xlTemp.Worksheets(1).Activate
xlTemp.Save

'Done
GoTo Cleanup

Else

'This filename exists - send message to user
MsgBox newFileName & " Already exists in the " & DirName & " directory." & vbCrLf & "Process has aborted.", vbCritical + vbOKOnly, "File Exists"
GoTo Cleanup

End If
Else

'Cannot determine unit number - send message
MsgBox "Must have an Unit Number assigned first, or Unit Number does not = 6.", vbCritical + vbOKOnly, "Missing Data"

End If

Cleanup:

'Dispose of our pointers - the user should have excel open to the rate sheet spreadsheet now
Set xlTemp = Nothing
Set xlApp = Nothing

End Sub
Sub UnHideVehiclePO()
Sheets("Vehicle PO").Visible = True
Sheets("Vehicle PO").Select
Range("B5").Select
End Sub
---------
Code:
Sub CopyRateSheet()
Application.ScreenUpdating = False
Dim varAnswer As Integer, varActiveBook As String
Dim varRGWorkbook As String, varsheetname As String

Dim sSheet1 As String
Dim sSheet2 As String

sSheet1 = "Proforma Rate Sheet"
sSheet2 = "Proforma Ancillary"

On Error Resume Next

' Order_Quote Workbook variable name
varActiveBook = ActiveWorkbook.Name
varsheetname = "HQ Pricing Review"

' Check to see if "HQ Pricing Review" exists, if Yes then ask to delete
If WorksheetExists(sSheet1) Then
varAnswer = MsgBox(sSheet1 & " already exists. Do you want to replace it?", vbQuestion + vbYesNo, "Worksheet Already Exists")

Select Case varAnswer

Case vbNo

' if the user answers no then exit the sub and do nothing
Exit Sub

End Select
End If

'Do not display action
Application.ScreenUpdating = False

'Delete the current sheets in the order workbook
Application.DisplayAlerts = False
ActiveWorkbook.Sheets("HQ Pricing Review").Delete 'Left in just in case this was still around
ActiveWorkbook.Sheets(sSheet1).Delete
ActiveWorkbook.Sheets(sSheet2).Delete
Application.DisplayAlerts = True


' 1. First open ratesheet template
' 2. Populate the ratesheet with data from this workbook
' 3. Copy "Rate Sheet" tab from template to this workbook and rename it to specified tab name
' 4. Then copy and paste special to get rid of all the formula's
' 5. Copy "Ancillary" tab from template to this workbook and rename it to specified tab name
' 6. Then copy and paste special to get rid of all the formula's
' 7. Close the workbook

'Open Rate Sheet Template
Dim filename As String, fName As String, DirName As String, varSheet1 As String, varSourceDoc As String
filename = ThisWorkbook.Worksheets("Parameter_Constants").Range("PreRateSheetTemplate").Value

varSheet1 = "HQ Summary"

'Open rate sheet template into current application
Dim pRatesheetWB As Excel.Workbook
'Set pRatesheetWB = Workbooks.Add(Template:=filename)
Set pRatesheetWB = Workbooks.Open(filename)

'Disable the "Player piano" effect
pRatesheetWB.Application.ScreenUpdating = False

'Populate the ratesheet template
Call WorkbookToRatesheetTransfer(pRatesheetWB, ByVal varSheet1, bIncludeActuals:=True)

'Do Ancillary sheet
Call CopySheetWithDropdowns(pRatesheetWB, "Ancillary", ThisWorkbook, sSheet2, "CST and Operations Processes")

'Do the rate sheet
Call CopySheetWithDropdowns(pRatesheetWB, "Rate Sheet", ThisWorkbook, sSheet1, "CST and Operations Processes")

'Now dispose of the ratesheet template that we have used
Call pRatesheetWB.Close(SaveChanges:=False)
Set pRatesheetWB = Nothing

'Done
GoTo Cleanup
Exit Sub
Cleanup:

Application.ScreenUpdating = True

End Sub
 
Last edited by a moderator:

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top