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

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
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

AndyTampa
  • Solved
How do I create one variable on a sheet available to all macros and ActiveX buttons
Replies
2
Views
169
AndyTampa
AndyTampa
G
  • Solved
Dynamic Button for Email Macro
Replies
4
Views
201
GarnesGambit
G
S
  • Solved
For each row, create new folder based on single cell value, then save exported XML doc to matching folder.
Replies
3
Views
143
shand
S
A
  • Solved
3 way use button to run macro
Replies
2
Views
56
Aleytha
A
Q
  • Question
how to edit this macro to export to desktop regardless of user?
Replies
3
Views
444
Radoslaw Poprawski
R

Forum statistics

Threads
1,214,625
Messages
6,120,598
Members
448,973
Latest member
ksonnia

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