How to create a button that executes more code all within one macro?

Clyp

New Member
Joined
Mar 10, 2022
Messages
4
Office Version
  1. 2021
Platform
  1. Windows
I'm a first year mech engr student and I decided to make a macro to setup our homework sheets for my excel class. I currently have it in two parts. The first macro creates a prompt sheet where you fill in the required information and also a "Ready" button which executes the second macro on press. The second macro is what actually creates the sheets with the given info from the prompt page.

What I'd like to do, is to be able to compress this all down into a single macro. In order to do that I need to figure out how to place the code of the second macro into the VBA-created button itself, rather than have the button call to another macro.

If only I could paste the code of the second macro right after "Selection.OnAction = "...
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
21,514
Office Version
  1. 365
  2. 2007
Platform
  1. Windows
You might be better off posting the 2 macros in question...then someone may be able to assist in "compressing" them into one !!
 
Upvote 0

Clyp

New Member
Joined
Mar 10, 2022
Messages
4
Office Version
  1. 2021
Platform
  1. Windows
You might be better off posting the 2 macros in question...then someone may be able to assist in "compressing" them into one !!
I didnt think it would be necessary because its more of a conceptual question but yeah I'll post it right now!
 
Upvote 0

Clyp

New Member
Joined
Mar 10, 2022
Messages
4
Office Version
  1. 2021
Platform
  1. Windows
VBA Code:
Sub HWSetupPrompt()
'
' HWSetupPrompt Macro
'

'
    ActiveSheet.Name = "SetupSheet"
    Columns("A:C").Select
    Selection.ColumnWidth = 18.29
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "HMK#"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Chapter#"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Problem #s In Order"
    Range("A4").Value = "Name Below"
    Range("A1:C2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("C3:C4").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A4:A5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A1").Select
    
        ActiveSheet.Buttons.Add(100.5, 45, 96.75, 28.5).Select
    Selection.OnAction = "PERSONAL.XLSB!HomeworkHeadersV2"
    Selection.Characters.Text = "Ready!"
    With Selection.Characters(Start:=1, Length:=6).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
    Range("C5").Select
    ActiveSheet.Shapes.Range(Array("Button 1")).Select
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 50
    End With
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleSingle
        .ColorIndex = 50
    End With
    
End Sub
Sub SheetCreation()
'
' SheetCreation Macro
'

'
    Dim HK As String
    Dim HKV As String
    Dim CH As String
    Dim CHV As String
    Dim P As String
    Dim P1 As String
    Dim P2 As String
    Dim P3 As String
    Dim Name As String
    
    
    HK = "Hmk# "
    CH = "Larsen Ch. "
    P = "Problem "
    HKV = Worksheets("SetupSheet").Range("A2")
    CHV = Worksheets("SetupSheet").Range("B2")
    P1 = Worksheets("SetupSheet").Range("C2")
    P2 = Worksheets("SetupSheet").Range("C3")
    P3 = Worksheets("SetupSheet").Range("C4")
    Name = Worksheets("SetupSheet").Range("A5")
    
    Sheets.Add After:=ActiveSheet
    Columns("A:G").Select
    Selection.ColumnWidth = 11.57
    Range("A1:B1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A1:B1").Value = Name
    Range("A2").Value = HK & HKV
    Range("D1").Value = "EASC 1112-01"
    Range("D2").Value = CH & CHV
    Range("G1").Value = Format(Now(), "mm/dd/yyyy")
    Range("A1:G2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("A1:G2").Select
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Columns("A:G").Select
    Range("A2").Activate
    Application.CutCopyMode = False
    Selection.ColumnWidth = 11.57
    Range("A1:G2").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Columns("A:G").Select
    Range("A2").Activate
    Application.CutCopyMode = False
    Selection.ColumnWidth = 11.57
    Range("A1:B1").Select
    
    Range("G2").Value = P & P3
    Sheets("Sheet3").Select
    Range("G2").Value = P & P2
    Sheets("Sheet2").Select
    Range("G2").Value = P & P1
    Range("A1:B1").Select
    
    ActiveSheet.Name = Range("G2").Value
    Sheets("Sheet3").Select
    ActiveSheet.Name = Range("G2").Value
    Sheets("Sheet4").Select
    ActiveSheet.Name = Range("G2").Value
    
    Application.DisplayAlerts = False
    Sheets("SetupSheet").Select
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    
End Sub
 
Upvote 0

Clyp

New Member
Joined
Mar 10, 2022
Messages
4
Office Version
  1. 2021
Platform
  1. Windows
VBA Code:
Sub HWSetupPrompt()
'
' HWSetupPrompt Macro
'

'
    ActiveSheet.Name = "SetupSheet"
    Columns("A:C").Select
    Selection.ColumnWidth = 18.29
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "HMK#"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Chapter#"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Problem #s In Order"
    Range("A4").Value = "Name Below"
    Range("A1:C2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("C3:C4").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A4:A5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A1").Select
   
        ActiveSheet.Buttons.Add(100.5, 45, 96.75, 28.5).Select
    Selection.OnAction = "PERSONAL.XLSB!HomeworkHeadersV2"
    Selection.Characters.Text = "Ready!"
    With Selection.Characters(Start:=1, Length:=6).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
    Range("C5").Select
    ActiveSheet.Shapes.Range(Array("Button 1")).Select
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 50
    End With
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleSingle
        .ColorIndex = 50
    End With
   
End Sub
Sub SheetCreation()
'
' SheetCreation Macro
'

'
    Dim HK As String
    Dim HKV As String
    Dim CH As String
    Dim CHV As String
    Dim P As String
    Dim P1 As String
    Dim P2 As String
    Dim P3 As String
    Dim Name As String
   
   
    HK = "Hmk# "
    CH = "Larsen Ch. "
    P = "Problem "
    HKV = Worksheets("SetupSheet").Range("A2")
    CHV = Worksheets("SetupSheet").Range("B2")
    P1 = Worksheets("SetupSheet").Range("C2")
    P2 = Worksheets("SetupSheet").Range("C3")
    P3 = Worksheets("SetupSheet").Range("C4")
    Name = Worksheets("SetupSheet").Range("A5")
   
    Sheets.Add After:=ActiveSheet
    Columns("A:G").Select
    Selection.ColumnWidth = 11.57
    Range("A1:B1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A1:B1").Value = Name
    Range("A2").Value = HK & HKV
    Range("D1").Value = "EASC 1112-01"
    Range("D2").Value = CH & CHV
    Range("G1").Value = Format(Now(), "mm/dd/yyyy")
    Range("A1:G2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("A1:G2").Select
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Columns("A:G").Select
    Range("A2").Activate
    Application.CutCopyMode = False
    Selection.ColumnWidth = 11.57
    Range("A1:G2").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Columns("A:G").Select
    Range("A2").Activate
    Application.CutCopyMode = False
    Selection.ColumnWidth = 11.57
    Range("A1:B1").Select
   
    Range("G2").Value = P & P3
    Sheets("Sheet3").Select
    Range("G2").Value = P & P2
    Sheets("Sheet2").Select
    Range("G2").Value = P & P1
    Range("A1:B1").Select
   
    ActiveSheet.Name = Range("G2").Value
    Sheets("Sheet3").Select
    ActiveSheet.Name = Range("G2").Value
    Sheets("Sheet4").Select
    ActiveSheet.Name = Range("G2").Value
   
    Application.DisplayAlerts = False
    Sheets("SetupSheet").Select
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
   
End Sub
So I would like the code in "SheetCreation" to be embedded into the button created in "HWSetupPrompt". Without calling it as a seperate macro of course...
 
Upvote 0

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
21,514
Office Version
  1. 365
  2. 2007
Platform
  1. Windows
Don't have Excel at the moment but have shortened the first code up a bit.......will have look later if no one else joins in.
VBA Code:
Sub HWSetupPrompt()
    ActiveSheet.Name = "SetupSheet"
    Columns("A:C").ColumnWidth = 18.29
    Range("A1").Value = "HMK#"
    Range("B1").Value = "Chapter#"
    Range("C1").Value = "Problem #s In Order"
    Range("A4").Value = "Name Below"
    With Range("A1:C2, C3:C4, A4:A5").Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    ActiveSheet.Buttons.Add(100.5, 45, 96.75, 28.5).Select
    Selection.OnAction = "PERSONAL.XLSB!HomeworkHeadersV2"
    Selection.Characters.Text = "Ready!"
    With Selection.Characters(Start:=1, Length:=6).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .ColorIndex = 1
    End With
    Range("C5").Select
    ActiveSheet.Shapes.Range(Array("Button 1")).Select
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Underline = xlUnderlineStyleSingle
        .ColorIndex = 50
    End With
    
End Sub
 
Upvote 0

Forum statistics

Threads
1,186,440
Messages
5,957,848
Members
438,325
Latest member
fanofstuff

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
Top