Can you call a macro from another workbook

M

mwatson

New Member
Joined
Sep 3, 2011
Messages
40
It's just as the title says I have a workbook and I want to use a very large macro that calls other macro's but all this is based in another workbook.
Is this possbile or do I have to copy all the original macro's from the MASTER workbook in to the duplicate workbook and access it from there?
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Sort by date Sort by votes
Do you mean you want to run the macro manually, or in code in the other workbook?
 
Upvote 0
In code you use Application.Run:
Code: 
Application.Run "'workbook name.xls'!macro_name"
for example. If you need to pass arguments, you can do so as arguments to Run, but be aware that any objects are passed ByVal, not ByRef.
 
Upvote 0
What have I done wrong as this just gets to your line and then errors?

Private Sub CommandButton11_Click()

On Error GoTo ERR
Windows("Customer_Returns_Log.xls").Activate

CONT1:
Application.Run "'Customer_Returns_Log.xls'!CRF_CRL_V2"
Exit Sub

ERR:
Workbooks.Open Filename:="H:\Data_Base\Customer_Returns\Customer_Returns_Log.xls"
GoTo CONT1
End Sub
 
Upvote 0
What is the error message?
 
Upvote 0
What does the CRF_CRL_V2 routine look like? Does it take any arguments? Where is it located (which module)?
 
Upvote 0
This is located in Module 4 in the Customer Return Log.xls

Sub Create_CRF_CRL_V2()

'
Dim Customer As String
Dim CONTACT As String
Dim EMAIL As String
Dim TEL As String
Dim BRANCH(20) As String
Dim Address(7) As String
Dim GD_CONTACT As String
' Dim NO_TYP As Single
Dim NO_TYP_COUNT As Single
Dim TYP As String
Dim EMPLOYEE As String
Dim Qty(1000) As Single
Dim PT_NO(10) As String
Dim PT_NO_SAVE As String
Dim REC_DATE As String
Dim PAL As String
Dim S_NO As String
Dim QPB As String
Dim CR_NO(10) As String
Dim CRF_TEMP_DIR As String
Dim CRF_TEMP As String
Dim CRF_DOC_DIR As String
Dim CRF_DOC As String
Dim CR_NAME As String
Dim vbCancel As Single
Dim vbOKCancel As Single
Dim ERR As Single
Dim ws As String
Dim CRL_DOC As String
Dim ExistCust As Single
Dim CustNum As String




'CONT 1,2,3,4,5,6,7,8,9,10
',11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27
'LOP 1,2,3,4,5,6,7

' Application.ScreenUpdating = False
START:
'Work
CRF_TEMP_DIR = "H:\Data_Base\Customer_Returns\CR_templates\"
'Home
' CRF_TEMP_DIR = "E:\GD\Data_Base\Customer_Returns\CR_templates\"
'-----------------------------------------------------------------------------------------
'Work
CRF_DOC_DIR = "H:\Data_Base\Customer_Returns\CR_Forms\"
'Home
' CRF_DOC_DIR = "E:\GD\Data_Base\Customer_Returns\CR_Forms\"
'-----------------------------------------------------------------------------------------

CRF_TEMP = "Customer_Return_Template-DUMB.xlt"
ws = "ALTON WORKSHOP SCHEDULE.xls"
CRL_DOC = "Customer_Returns_Log.xls"
QPB = 1
Call Select_Customer_And_PN(ExistCust, CustNum)
If ExistCust = 0 Then GoTo CONT27
If ExistCust = 1 Then
Call Collect_Existing_data(CustNum, ExistCust)
Exit Sub
End If
If ExistCust = 2 Then
Call Collect_Existing_data(CustNum, ExistCust)
Exit Sub
End If
If ExistCust = 3 Then
If CustNum = "" Then
MboxAns = MsgBox("You did not select a customer, Try again?", vbYesNo, "Try Again?")
If MboxAns = 6 Then GoTo START
End If
If CustNum = "AADefault" Then
MboxAns = MsgBox("You did not select a customer, Try again?", vbYesNo, "Try Again?")
If MboxAns = 6 Then GoTo START
Exit Sub
End If
Exit Sub
End If


CONT27:
Customer = InputBox("Customer Company Name?", "Customer?", "")
If StrPtr(Customer) = 0 Then
Exit Sub
Else
GoTo CONT3
End If
CONT3:
If Customer = "" Then Customer = "-"
CONTACT = InputBox("Customer Contact Name?", "Contact Name?", "")
If StrPtr(CONTACT) = 0 Then
Exit Sub
Else
GoTo CONT4
End If
CONT4:
If CONTACT = "" Then CONTACT = "-"

EMAIL = InputBox("Customer contact email address?", "Contact email?", "")
If StrPtr(EMAIL) = 0 Then
Exit Sub
Else
GoTo CONT5
End If
CONT5:
If EMAIL = "" Then EMAIL = "-"


TEL = InputBox("Customer contact telephone number?", "Contact Tel?", "")
If StrPtr(TEL) = 0 Then
Exit Sub
Else
GoTo CONT6
End If
CONT6:
If TEL = "" Then TEL = "-"
CONT19:
On Error GoTo QTY_ERR
NO_TYP = InputBox("How many different part numbers are being returned?", "Number of Types of Pumps?", "1")
If StrPtr(NO_TYP) = 0 Then
Exit Sub
Else
GoTo CONT7
End If
CONT7:
NO_TYP_COUNT = 1
LOP1:
PT_NO(NO_TYP_COUNT) = InputBox("Part Number " & NO_TYP_COUNT & "?", "Part Number " & NO_TYP_COUNT & "?", "")
If StrPtr(PT_NO(NO_TYP_COUNT)) = 0 Then
Exit Sub
Else
GoTo CONT8
End If
CONT8:
If NO_TYP_COUNT = NO_TYP Then GoTo CONT11
NO_TYP_COUNT = NO_TYP_COUNT + 1
GoTo LOP1
CONT11:
NO_TYP_COUNT = 1
LOP3:
CONT17:
On Error GoTo QTY_ERR1
Qty(NO_TYP_COUNT) = InputBox("Quantity of " & PT_NO(NO_TYP_COUNT) & " to be returned?", "Part Number " & NO_TYP_COUNT & "?", "")
If StrPtr(Qty(NO_TYP_COUNT)) = 0 Then
Exit Sub
Else
GoTo CONT12
End If
CONT12:
If NO_TYP_COUNT = NO_TYP Then GoTo CONT13
NO_TYP_COUNT = NO_TYP_COUNT + 1
GoTo LOP3
CONT13:
On Error GoTo ERR_BRANCH
BRANCH(1) = InputBox("Which branch are the parts/pumps to be returned to? _ 1 = Alton _ 2 = Larkfield _ 3 = Tewkesbury _ 4 = Bradford", "Branch?", "1")
If StrPtr(BRANCH(1)) = 0 Then
Exit Sub
Else
GoTo CONT20
End If
CONT20:

If BRANCH(1) = 1 Then GoTo ALTON
If BRANCH(1) = 2 Then GoTo LARKFIELD
If BRANCH(1) = 3 Then GoTo TEWKESBURY
If BRANCH(1) = 4 Then GoTo BRADFORD
GoTo ERR_BRANCH

ALTON:
BRANCH(1) = "Alton"
BRANCH(2) = ""
BRANCH(3) = "
BRANCH(4) = "
BRANCH(5) = "
BRANCH(6) = "
BRANCH(7) = "
BRANCH(8) = "
BRANCH(9) = ""
GoTo CONT18
LARKFIELD:
BRANCH(1) = "
BRANCH(2) = "
BRANCH(3) = "
BRANCH(4) = "
BRANCH(5) = "
BRANCH(6) = "
BRANCH(7) = "
BRANCH(8) = "
BRANCH(9) = ""
GoTo CONT18
TEWKESBURY:
BRANCH(1) = ""

'fax 01684 291920
GoTo CONT18
BRADFORD:
BRANCH(1) = ""


CONT18:
GD_CONTACT = InputBox("employee name?", "employee name", "")
If StrPtr(GD_CONTACT) = 0 Then
Exit Sub
Else
GoTo CONT21
End If
CONT21:

If GD_CONTACT = "" Then GD_CONTACT = "-"
'Call QSAVE
'------------------------------------------------------------
'Get CR#

Sheets("CRN").Select
NO_TYP_COUNT = 1
Range("b4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Offset(0, 0).Range("A1:A" & NO_TYP).Select
Selection.FormulaR1C1 = Customer
ActiveCell.Offset(0, 1).Range("A1").Select
LOP2:
Selection.FormulaR1C1 = PT_NO(NO_TYP_COUNT)
If NO_TYP_COUNT = NO_TYP Then GoTo CONT1
NO_TYP_COUNT = NO_TYP_COUNT + 1
ActiveCell.Offset(1, 0).Range("A1").Select
GoTo LOP2
CONT1:
ActiveCell.Offset(-NO_TYP + 1, -2).Range("A1").Select
NO_TYP_COUNT = 1
LOP7:
CR_NO(NO_TYP_COUNT) = ActiveCell
If NO_TYP_COUNT = NO_TYP Then GoTo CONT2
NO_TYP_COUNT = NO_TYP_COUNT + 1
ActiveCell.Offset(1, 0).Range("A1").Select
GoTo LOP7
'------------------------------------------------------------
'Complete CRL
CONT2:
Sheets("CRL").Select
NO_TYP_COUNT = 1
Range("b4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Offset(0, 0).Range("A1:A" & NO_TYP).Select
Selection.FormulaR1C1 = Customer
ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.Offset(0, 0).Range("A1:A" & NO_TYP).Select
Selection.FormulaR1C1 = CONTACT
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Offset(0, 0).Range("A1:A" & NO_TYP).Select
Selection.FormulaR1C1 = EMAIL
ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.Offset(0, 0).Range("A1:A" & NO_TYP).Select
Selection.FormulaR1C1 = TEL
ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.Offset(0, 0).Range("A1:A" & NO_TYP).Select
Selection.FormulaR1C1 = "T.B.A."
ActiveCell.Offset(0, 6).Range("A1").Select

ActiveCell.Offset(0, 0).Range("A1:A" & NO_TYP).Select
Selection.FormulaR1C1 = BRANCH(1)
ActiveCell.Offset(0, 1).Range("A1").Select

ActiveCell.Offset(0, 0).Range("A1:A" & NO_TYP).Select
Selection.FormulaR1C1 = GD_CONTACT
ActiveCell.Offset(0, -6).Range("A1").Select

LOP4:
ActiveCell = Qty(NO_TYP_COUNT)
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = PT_NO(NO_TYP_COUNT)
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = "T.B.A."
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = "T.B.A."
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = "Awaiting"
ActiveCell.Offset(1, -4).Range("A1").Select
If NO_TYP_COUNT = NO_TYP Then GoTo CONT14
NO_TYP_COUNT = NO_TYP_COUNT + 1
GoTo LOP4
CONT14:
ActiveCell.Offset(-NO_TYP, -6).Range("A1").Select

NO_TYP_COUNT = 1
LOP5:
ActiveCell = CR_NO(NO_TYP_COUNT)
On Error Resume Next
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
CRF_DOC_DIR & CR_NO(NO_TYP_COUNT) & ".xls"
' CR_NO(NO_TYP_COUNT) = ActiveCell
ActiveCell.Offset(1, 0).Range("A1").Select
If NO_TYP_COUNT = NO_TYP Then GoTo CONT15
NO_TYP_COUNT = NO_TYP_COUNT + 1
GoTo LOP5
CONT15:
'Call QSAVE
NO_TYP_COUNT = 1
'Create Customer return Doc
On Error GoTo ERR_OPEN_FILE

ChDir CRF_TEMP_DIR

LOP6:
Workbooks.Open Filename:=CRF_TEMP_DIR & CRF_TEMP
Sheets("Returns Note").Select
Columns("x:x").Select
Selection.EntireColumn.Hidden = True
Range("f2").Select
Sheets("Declaration").Select
Range("d3").Select
Range("d2").Select
ActiveCell = CR_NO(NO_TYP_COUNT)

Sheets("Returns Note").Select
Range("b22").Select
ActiveCell = PT_NO(NO_TYP_COUNT)
Range("b4").Select
ActiveCell = BRANCH(2)
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell = BRANCH(3)
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell = BRANCH(4)
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell = BRANCH(5)
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell = BRANCH(6)
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell = BRANCH(7)
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell = BRANCH(8)
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell = BRANCH(9)
Range("a1").Select
Range("f2").Select

Sheets("Declaration").Select
Application.ScreenUpdating = True
Range("a3").Select
Application.ScreenUpdating = False
Range("a6").Select
CR_NAME = CRF_DOC_DIR & CR_NO(NO_TYP_COUNT) & ".xls"
ActiveWorkbook.SaveAs Filename:=CR_NAME, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close

If NO_TYP_COUNT = NO_TYP Then GoTo CONT16
NO_TYP_COUNT = NO_TYP_COUNT + 1

GoTo LOP6
CONT16:
NO_TYP_COUNT = 1
ActiveWorkbook.Save
Application.ScreenUpdating = True
'MsgBox = MsgBox("You have now successfully created all Customer Returns form that are ready to be sent to the customer, please send these files to the customer:-" & CR_NO(NO_TYP_COUNT))
If NO_TYP > 1 Then GoTo CONT25
MboxAns = MsgBox("You have now successfully created the 'Customer Returns Forms' and it is ready to be sent to the customer, please send this file to the customer:- " & CR_NO(NO_TYP_COUNT) & ". You can find the file in " & CRF_DOC_DIR, vbOK)
GoTo CONT9
CONT25:
MboxAns = MsgBox("You have now successfully created all 'Customer Returns Forms' and they are ready to be sent to the customer, please send these files to the customer:- " & CR_NO(NO_TYP_COUNT) & "-" & CR_NO(NO_TYP) & ". You can find these files in " & CRF_DOC_DIR, vbOK)
GoTo CONT9

CONT10:

Workbooks.Open Filename:=CRF_TEMP_DIR & CRF_TEMP

CONT9:
' Range("B2").Select
' Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
' Range("b2").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True

ActiveCell.Offset(-NO_TYP, 3).Range("A1").Select
ActiveCell.Offset(0, 0).Range("A1:A1").Select
' Selection.FormulaR1C1 = CONTACT
'
On Error Resume Next
NO_TYP_COUNT = 1
LOP8:
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"mailto:" & EMAIL & "?subject=" & Customer & "%20-%20" & PT_NO(1) & "%20-%20" & CR_NO(NO_TYP_COUNT), TextToDisplay _
:=EMAIL
If NO_TYP_COUNT = NO_TYP Then GoTo CONT26
NO_TYP_COUNT = NO_TYP_COUNT + 1
ActiveCell.Offset(1, 0).Range("A1").Select
GoTo LOP8

CONT26:
On Error Resume Next
' ActiveSheet.Hyperlinks(ActiveSheet.Hyperlinks.Count).CreateNewDocument _
Filename:="mailto:" & EMAIL & "?subject=" & CUSTOMER & "%20-%20" & PT_NO(1) & "%20-%20" & CR_NO(NO_TYP_COUNT) & "-" & CR_NO(NO_TYP), EditNow:=True, Overwrite:=False
' Range("B2").Select
' Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Call Add_CRF_To_WS(CRL_DOC, NO_TYP, ws)
Exit Sub
QTY_ERR:
MboxAns = MsgBox("You have incorrectly filled out this question, please only enter a single number e.g '100'", vbOK)
If MboxAns = 2 Then
Exit Sub
Else
GoTo CONT22
End If
CONT22:
On Error Resume Next
GoTo CONT19
QTY_ERR1:
MboxAns = MsgBox("You have incorrectly filled out this question, please only enter a single number e.g '100'", vbOK)
If MboxAns = 2 Then
Exit Sub
Else
GoTo CONT23
End If
CONT23:
On Error Resume Next
GoTo CONT17
ERR_BRANCH:
MboxAns = MsgBox("You have incorrectly filled out this question, please only enter a single number e.g '1' for Alton", vbOK)
If MboxAns = 2 Then
Exit Sub
Else
GoTo CONT24
End If
CONT24:
On Error Resume Next
GoTo CONT13
Exit Sub
ERR_OPEN_FILE:
' MboxAns = MsgBox("The Customer_Return_Form.xls is not open would you like me to open it and continue?", vbYesNo)
' If MboxAns = vbYes Then GoTo CONT10
' If MboxAns = vbNo Then Exit Sub

ERR_CANCEL:
End Sub
 
Upvote 0
That sub is called "Create_CRF_CRL_V2" not "CRF_CRL_V2"...
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Cannot assign macro to button
2
Replies
10
Views
292
SPS41
S
A
  • Solved
Copy Entire Workbook, save as sheet name with current date, hide all sheets except one, & attach to email
Replies
2
Views
639
Amo840812
A
S
  • Solved
run macro from network xlam addin via vba
Replies
2
Views
365
solidENM
S
F
  • Question Question
Excel Help with VBA Code
Replies
6
Views
173
mumps
mumps
D
  • Solved
Trying to copy data from a specific sheet in one workbook to another with VBA
Replies
2
Views
173
druck21
D

Forum statistics

Threads
1,224,801
Messages
6,181,047
Members
453,014
Latest member
Chris258

Share this page

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