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

C

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

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
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
Michael M said:
You might be better off posting the 2 macros in question...then someone may be able to assist in "compressing" them into one !!
Click to expand...
I didnt think it would be necessary because its more of a conceptual question but yeah I'll post it right now!
 
Upvote 0
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 said:
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
Click to expand...
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
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
You must log in or register to reply here.

Similar threads

S
  • Solved
Cannot assign macro to button
2
Replies
10
Views
294
SPS41
S
A
  • Question Question
How do I create a reset button that unchecks checkboxes in my spreadsheet - but not all of them?
Replies
6
Views
265
dmt32
D
W
  • Question Question
Creating a 'Reset' button for a text form, plus additional buttons
Replies
2
Views
309
WEB78
W
A
  • Question Question
Macro VBA hide/unhide with veryHidden option and VBA password
Replies
1
Views
713
alexbw
A
C
  • Solved
Extracting data with VBA macro button from files in designated folder
2 3
Replies
20
Views
1K
Micron
M

Forum statistics

Threads
1,224,820
Messages
6,181,159
Members
453,021
Latest member
Justyna P

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