Hello....I'm a noob when it comes to this. I've come along way but I've been trying for about 2 hours now to get this to work. I'm desperate....Please help!
I have code that works great. When a button is clicked it copies a master template sheet to the end of the tabs and names it according to a cell. I'm trying to figure out how to have all my macros in a "master" workbook and have a macro in the "user" workbook that references the macro in the "master".
Here is the working code that I'm trying to do this with:
I took the code above out of the user workbook and put it into the master workbook. I put this code in the user workbook to refer to and run it.
I've tested this with a small procedure and it worked so I know it's possible. I've tried everything to get my code to work and I'm about at my wits end. I've gotten as far as getting the template sheet to copy and paste into the user workbook but it won't change the name. Here is my edited code so far:
I can upload and share my workbooks to Send Anywhere if needed. Thank you so much to anyone that will take the time to help me out.
Oh, in case it's relevant, I'm getting an error on this line that says Object doesn't support this property or method.
I have code that works great. When a button is clicked it copies a master template sheet to the end of the tabs and names it according to a cell. I'm trying to figure out how to have all my macros in a "master" workbook and have a macro in the "user" workbook that references the macro in the "master".
Here is the working code that I'm trying to do this with:
Code:
Sub BuildSheet1_B29()
Dim numrows As Long, i As Long
Dim sname As String
Dim objMySheet As Object
Dim varInvalidChars As Variant
Dim lngCellPos As Long
varInvalidChars = Array(":", "\", "/", "?", "*", "[", "]")
Application.ScreenUpdating = False
With Sheet10 'Sheet name for the main sheet where the button will be.
numrows = WorksheetFunction.CountA(.Range("B29"))
If numrows = 0 Then Exit Sub
For i = 1 To numrows
'Check for invalid characters within the proposed name
For lngCellPos = 1 To Len(.Cells(i + 28, "B").Value)
If IsNumeric(Application.Match(Mid(.Cells(i + 28, "B").Value, lngCellPos, 1), varInvalidChars, 0)) = True Then
MsgBox "The name you're trying to enter in cell B" & i + 28 & " contains one or more invalid characters." & vbNewLine & "Remove any invalid characters: : \ / ? * [ or ] and try again.", vbCritical
Exit Sub
End If
Next lngCellPos
'Proposed sheet name validation
If Len(.Cells(i + 28, "B").Value) = 0 Then
MsgBox "You have not entered a name in cell B" & i + 28 & "." & vbNewLine & "Ensure there is a name in the cell and try again.", vbCritical
Exit Sub
ElseIf Len(.Cells(i + 28, "B").Value) > 31 Then
MsgBox "The name you're trying to enter in cell B" & i + 28 & " has more then 31 characters." & vbNewLine & "Ensure the name has a maximum of 31 characters and try again.", vbCritical
Exit Sub
ElseIf StrConv(.Cells(i + 28, "B").Value, vbProperCase) = "History" Then
MsgBox "A tab cannot be named ""History"" as it is a reserved name." & vbNewLine & "Change the name in cell B" & i + 28 & " and try again.", vbCritical
Exit Sub
Else
'If the proposed name in cell B[i+28] already exists in the workbook, then...
On Error Resume Next 'Stop run-time error 9 message if the tab doesn't exist
Set objMySheet = Sheets(.Cells(i + 28, "B").Value)
If Err.Number = 0 Then
'...put that name to the 'sname' variable and alert the user that it already exists and quit the routine.
sname = .Cells(i + 28, "B").Value
MsgBox "There is already a Training Worksheet called """ & sname & """ in the workbook." & vbNewLine & "Remove or change the name in cell B" & i + 28 & " and try again.", vbCritical
Exit Sub
End If
On Error GoTo 0
End If
'If the code gets here copy the template sheet (set here as 'Sheet2') to the end of this workbook and name it via the text in cell B[i+28]
Sheet2.Copy After:=Sheets(Sheets.Count)
ThisWorkbook.Sheets(Sheets.Count).Name = .Cells(i + 28, "B").Value
Sheet6.Activate
ActiveSheet.Unprotect
Range("A8").Select 'Selects Cell A8 on Sheet 6 (Status sheet). This cell holds the value "CORE" to copy into the Range of cells below.
Selection.Copy
Range("C12,E12,G12,I12,K12,M12,Q12,S12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I71").Select 'Selects Cell I71 on Sheet 6 (Status sheet). This cell holds the value "NO CORE" to copy into the Range of cells below.
Selection.Copy
Range("O12:P12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("U11").Select
ActiveSheet.Protect
Sheet10.Activate
Sheet10.Protect
Next i
End With
Set objMySheet = Nothing
Application.ScreenUpdating = True
End SubI took the code above out of the user workbook and put it into the master workbook. I put this code in the user workbook to refer to and run it.
Code:
Sub Build_B29()
Application.ScreenUpdating = False
Application.Run ("'S:\OSL\AFE Training\CodeMasterWorkbook.xlsm'!BuildSheet1_B29")
Application.ScreenUpdating = True
End SubI've tested this with a small procedure and it worked so I know it's possible. I've tried everything to get my code to work and I'm about at my wits end. I've gotten as far as getting the template sheet to copy and paste into the user workbook but it won't change the name. Here is my edited code so far:
Code:
Sub BuildSheet1_B29()
Dim numrows As Long, i As Long
Dim sname As String
Dim objMySheet As Object
Dim varInvalidChars As Variant
Dim lngCellPos As Long
Dim wkbMain As Object, wkbCode As Object
Dim ws1 As Worksheet
Dim wsname As Object
Set wkbMain = Workbooks("AFE C-130 Training Plan Test Copy.xlsm")
Set wkbCode = Workbooks("CodeMasterWorkbook.xlsm")
Set ws1 = Sheets("C-130 MTP Template")
Set wsname = wkbMain.Sheet("Setup").Cells(i + 28, "B").Value
varInvalidChars = Array(":", "\", "/", "?", "*", "[", "]")
Application.ScreenUpdating = False
With ActiveSheet 'Sheet name for the main sheet where the button will be.
numrows = WorksheetFunction.CountA(.Range("B29"))
If numrows = 0 Then Exit Sub
For i = 1 To numrows
'Check for invalid characters within the proposed name
For lngCellPos = 1 To Len(.Cells(i + 28, "B").Value)
If IsNumeric(Application.Match(Mid(.Cells(i + 28, "B").Value, lngCellPos, 1), varInvalidChars, 0)) = True Then
MsgBox "The name you're trying to enter in cell B" & i + 28 & " contains one or more invalid characters." & vbNewLine & "Remove any invalid characters: : \ / ? * [ or ] and try again.", vbCritical
Exit Sub
End If
Next lngCellPos
'Proposed sheet name validation
If Len(.Cells(i + 28, "B").Value) = 0 Then
MsgBox "You have not entered a name in cell B" & i + 28 & "." & vbNewLine & "Ensure there is a name in the cell and try again.", vbCritical
Exit Sub
ElseIf Len(.Cells(i + 28, "B").Value) > 31 Then
MsgBox "The name you're trying to enter in cell B" & i + 28 & " has more then 31 characters." & vbNewLine & "Ensure the name has a maximum of 31 characters and try again.", vbCritical
Exit Sub
ElseIf StrConv(.Cells(i + 28, "B").Value, vbProperCase) = "History" Then
MsgBox "A tab cannot be named ""History"" as it is a reserved name." & vbNewLine & "Change the name in cell B" & i + 28 & " and try again.", vbCritical
Exit Sub
Else
'If the proposed name in cell B[i+28] already exists in the workbook, then...
On Error Resume Next 'Stop run-time error 9 message if the tab doesn't exist
Set objMySheet = Sheets(.Cells(i + 28, "B").Value)
If Err.Number = 0 Then
'...put that name to the 'sname' variable and alert the user that it already exists and quit the routine.
sname = .Cells(i + 28, "B").Value
MsgBox "There is already a Training Worksheet called """ & sname & """ in the workbook." & vbNewLine & "Remove or change the name in cell B" & i + 28 & " and try again.", vbCritical
Exit Sub
End If
On Error GoTo 0
End If
'If the code gets here copy the template sheet (set here as 'Sheet2') to the end of this workbook and name it via the text in cell B[i+28]
With wkbMain
.Sheets("C-130 MTP Template").Copy After:=Sheets(Sheets.Count)
ThisWorkbook.Sheets(Sheets.Count).Name = wsname
wkbMain.Sheet6.Activate
ActiveSheet.Unprotect
Range("A8").Select 'Selects Cell A8 on Sheet 6 (Status sheet). This cell holds the value "CORE" to copy into the Range of cells below.
Selection.Copy
Range("C12,E12,G12,I12,K12,M12,Q12,S12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I71").Select 'Selects Cell I71 on Sheet 6 (Status sheet). This cell holds the value "NO CORE" to copy into the Range of cells below.
Selection.Copy
Range("O12:P12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("U11").Select
ActiveSheet.Protect
wkbMain.Sheet10.Activate
wkbMain.Sheet10.Protect
End With
Next i
End With
Set objMySheet = Nothing
Application.ScreenUpdating = True
End SubI can upload and share my workbooks to Send Anywhere if needed. Thank you so much to anyone that will take the time to help me out.
Oh, in case it's relevant, I'm getting an error on this line that says Object doesn't support this property or method.
Code:
Set wsname = wkbMain.Sheet("Setup").Cells(i + 28, "B").Value
Last edited:
