New sheet with name and copied data based on macro button on each respective row

[cdalgorta]

I got the first part(putting the buttons on each row) from NateSC here in MrExcel, so shout out to him!


So I need the "Sheet #" macro buttons on J column to do the following:
- Create a new sheet with the name on column A of its respective row.
- Copy the titles on row 1(A1:K1) and copy the data on the respective row of the clicked button(Sheet 5 button copies A5:K5).
- Paste both rows on the new sheet on A1:K2 (paste as "keep source column width")
- Place this formulas on A3: =HYPERLINK("#'PYMT'!A1","HOME") -----> If possible, make it so A1 changes to the number of the row that was copied(Sheet 5 button would be =HYPERLINK("#'PYMT'!A5","HOME"). Or even better, if possible, make it so the hyperlink brings you back to the cell in the "PYMT" sheet that matches the name of cell A2 on each new sheet(the latter would be so much better because I could delete some rows on the PYMT sheet as I work on them and the hyperlink would still take me back to the correct cell on the PYMT sheet).

Thank you in advance!

Macro for buttons:

Sub Button_for_J()


'''''=========Make Buttons to create new sheets on J column==========

Dim rng As Range
Dim btn As Object
Dim myNumRows As Integer

' Based on Changing Button Caption using VBA & Assigning Macro to button using VBA

myNumRows = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

'Loop to make your buttons
For i = 2 To myNumRows
Set rng = ActiveSheet.Range("J" & i)
Set btn = ActiveSheet.Buttons.Add(1, 1, 100, 100)

With btn
'Set the button location to match the rng that was set above
.Top = rng.Top
.Left = rng.Left
.Width = rng.Width
.Height = rng.RowHeight
'Rename the button, change the caption, change the font size, set what it runs when clicked
.Name = i 'This number will be used in the next routine to know which row is affected
.Characters.Text = "Sheet " & i
.Characters.Font.Size = 10
.OnAction = "New_Sheet" ' Any time the new macro would have
End With

Next i

End Sub

 

[cdalgorta]

I think this will do what you are looking for. Please note that if the sheet already exists. pressing the button will cause an error. Let me know if you need a check for this condition. It isn't too complicated.

-N

Sub New_Sheet()

Dim myBtn As Object
Dim HomeWS As Worksheet
Dim NewName As String
Dim myWS As Worksheet

    'Need to determine which button was clicked
    Set myBtn = ActiveSheet.Shapes(Application.Caller)
   
    Set HomeWS = ActiveSheet
    NewName = ActiveSheet.Range("A" & myBtn.Name)
   
    'Create new sheet
    Set myWS = Sheets.Add
    myWS.Move after:=HomeWS
    myWS.Name = NewName
   
    'Copy the rows across
    HomeWS.Rows(1).EntireRow.Copy myWS.Range("A1")
    HomeWS.Rows(myBtn.Name).EntireRow.Copy myWS.Range("A2")
   
    'Build hyperlink
    myWS.Range("A3").Formula = "=hyperlink(""#'PYMT'!A" & myBtn.Name & """,""Home"")"
   
End Sub

Thank you so much! Absolutely perfect!

What would be that check you are mentioning? Right now if I click the same button twice, it causes an error and creates a blank new sheet. Would the check make it so nothing happens even if clicking the same button twice by accident?

 

[NateSC]

Yes. The second time you click the button it will cause an error because a sheet with that name already exists. We need to check for the name and then do something different.

The question is: What do you want it to do when the sheet already exists?
Some options:
- do nothing
- go to that sheet, but do nothing else
- create a second instance of that sheet with a slightly different name
- delete the first instance of that sheet and then recreate it from scratch
- password protect the file with a random password and close the file (not recommended)

-N

 

[cdalgorta]

Yes. The second time you click the button it will cause an error because a sheet with that name already exists. We need to check for the name and then do something different.

The question is: What do you want it to do when the sheet already exists?
Some options:
- do nothing
- go to that sheet, but do nothing else
- create a second instance of that sheet with a slightly different name
- delete the first instance of that sheet and then recreate it from scratch
- password protect the file with a random password and close the file (not recommended)

-N

I'd have said "do nothing" before, but the 2nd option to "go to that sheet, but do nothing else" sounds better. It would be like having a second "go to sheet" hyperlink like the one I have on column B. That'd nice.

By the way, I changed it a bit with very simple things in case you need to see what I have now before adding what you are mentioning.
Only changed the width of the columns
Deleted columns B, J and K
And made it so the Cell on column A of the pressed button turns yellow in the main "PYMT" sheet(to kind of remember if I had already pressed the button)
Thank you Nate


Sub New_Sheet()

Dim myBtn As Object
Dim HomeWS As Worksheet
Dim NewName As String
Dim myWS As Worksheet


'Need to determine which button was clicked
Set myBtn = ActiveSheet.Shapes(Application.Caller)

Set HomeWS = ActiveSheet
NewName = ActiveSheet.Range("A" & myBtn.Name)


'Make cell on column A yellow


Range("A" & myBtn.Name).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With




'Create new sheet
Set myWS = Sheets.Add
myWS.Move after:=HomeWS
myWS.Name = NewName

'Copy the rows across
HomeWS.Rows(1).EntireRow.Copy myWS.Range("A1")
HomeWS.Rows(myBtn.Name).EntireRow.Copy myWS.Range("A2")

'Build hyperlink
myWS.Range("A3").Formula = "=hyperlink(""#'PYMT'!A" & myBtn.Name & """,""Home"")"

'Fix Columns width

Columns("A:A").ColumnWidth = 9
Columns("C:C").ColumnWidth = 8
Columns("D:D").ColumnWidth = 8
Columns("E:E").ColumnWidth = 5
Columns("F:F").ColumnWidth = 40
Columns("G:G").ColumnWidth = 9
Columns("H:H").ColumnWidth = 9
Columns("I:I").ColumnWidth = 40


'Delete columns with buttons
Columns("J:K").Select
Selection.Delete Shift:=xlToLeft

'Delete "Go to sheet" column
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft

Range("A1").Select

End Sub

 

[NateSC]

Here you go. This method is the simplest form I have found to do this, but it does use more computing time than another version that uses an error trap. The difference really is not noticeable unless you are trying to do the test on thousands of tabs or have a computer that is really stressed for resources.

Sub New_Sheet()

Dim myBtn As Object
Dim HomeWS As Worksheet
Dim NewName As String
Dim myWS As Worksheet

Dim WorksheetExists as Boolean

    'Need to determine which button was clicked
    Set myBtn = ActiveSheet.Shapes(Application.Caller)
    
    Set HomeWS = ActiveSheet
    NewName = ActiveSheet.Range("A" & myBtn.Name)


    'Test if the worksheet name already exists
    WorksheetExists = Evaluate("ISREF('" & NewName & "'!A1)")

    If WorksheetExists Then

        Sheets(NewName).Activate
        Sheets(NewName).Range("A1").Select

    Else

        'Make cell on column A yellow
        Range("A" & myBtn.Name).Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
        
        'Create new sheet
        Set myWS = Sheets.Add
        myWS.Move after:=HomeWS
        myWS.Name = NewName
        
        'Copy the rows across
        HomeWS.Rows(1).EntireRow.Copy myWS.Range("A1")
        HomeWS.Rows(myBtn.Name).EntireRow.Copy myWS.Range("A2")
        
        'Build hyperlink
        myWS.Range("A3").Formula = "=hyperlink(""#'PYMT'!A" & myBtn.Name & """,""Home"")"
        
        'Fix Columns width
        
        Columns("A:A").ColumnWidth = 9
        Columns("C:C").ColumnWidth = 8
        Columns("D:D").ColumnWidth = 8
        Columns("E:E").ColumnWidth = 5
        Columns("F:F").ColumnWidth = 40
        Columns("G:G").ColumnWidth = 9
        Columns("H:H").ColumnWidth = 9
        Columns("I:I").ColumnWidth = 40
        
        
        'Delete columns with buttons
        Columns("J:K").Select
        Selection.Delete Shift:=xlToLeft
        
        'Delete "Go to sheet" column
        Columns("B:B").Select
        Selection.Delete Shift:=xlToLeft
        
        Range("A1").Select
        
    End If

End Sub

 

[cdalgorta]

Here you go. This method is the simplest form I have found to do this, but it does use more computing time than another version that uses an error trap. The difference really is not noticeable unless you are trying to do the test on thousands of tabs or have a computer that is really stressed for resources.

Sub New_Sheet()

Dim myBtn As Object
Dim HomeWS As Worksheet
Dim NewName As String
Dim myWS As Worksheet

Dim WorksheetExists as Boolean

    'Need to determine which button was clicked
    Set myBtn = ActiveSheet.Shapes(Application.Caller)
   
    Set HomeWS = ActiveSheet
    NewName = ActiveSheet.Range("A" & myBtn.Name)


    'Test if the worksheet name already exists
    WorksheetExists = Evaluate("ISREF('" & NewName & "'!A1)")

    If WorksheetExists Then

        Sheets(NewName).Activate
        Sheets(NewName).Range("A1").Select

    Else

        'Make cell on column A yellow
        Range("A" & myBtn.Name).Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
       
        'Create new sheet
        Set myWS = Sheets.Add
        myWS.Move after:=HomeWS
        myWS.Name = NewName
       
        'Copy the rows across
        HomeWS.Rows(1).EntireRow.Copy myWS.Range("A1")
        HomeWS.Rows(myBtn.Name).EntireRow.Copy myWS.Range("A2")
       
        'Build hyperlink
        myWS.Range("A3").Formula = "=hyperlink(""#'PYMT'!A" & myBtn.Name & """,""Home"")"
       
        'Fix Columns width
       
        Columns("A:A").ColumnWidth = 9
        Columns("C:C").ColumnWidth = 8
        Columns("D:D").ColumnWidth = 8
        Columns("E:E").ColumnWidth = 5
        Columns("F:F").ColumnWidth = 40
        Columns("G:G").ColumnWidth = 9
        Columns("H:H").ColumnWidth = 9
        Columns("I:I").ColumnWidth = 40
       
       
        'Delete columns with buttons
        Columns("J:K").Select
        Selection.Delete Shift:=xlToLeft
       
        'Delete "Go to sheet" column
        Columns("B:B").Select
        Selection.Delete Shift:=xlToLeft
       
        Range("A1").Select
       
    End If

End Sub

This is better than I ever hoped for. Thank you so much Nate!

May I know if you are self-taught or used an online course to get your VBA knowledge? If it's the latter, may I know which course? I'd liked to learn/study, but I rather learn the same way an expert did than just follow the recommendations from page 1 in Google or YouTube. I have asked in other posts I've made here, but my question seems to always get ignored hahah. Since all I got for now is Google recommendations, I'm between the "The Ultimate Excel Programmer Course" from Udemy and "Excel/VBA for Creative Problem Solving, Part 1/2/3" from Coursera. But any recommendation from you would be greatly appreciate it and taken as a priority hahah. Thank you Nate.

 

[NateSC]

Unfortunately, just self-taught with macros. I did take a Fortran class in college that taught me basic programming logic. Since then, I have been using macros for ~20 years and Excel for ~30. Even doing these macros for you required lots of Google searches on this forum and several others. I will dig and dig and then try stuff until I get it to work. I usually have a basic idea of how to get there, but I often need to look up the syntax. What you listed for this second problem was perfect though. You clearly outlined the steps that needed to be followed and it made the solution fairly easy because I could solve it in small pieces.

Good luck and reach out if I can ever help again.

 

[cdalgorta]

Unfortunately, just self-taught with macros. I did take a Fortran class in college that taught me basic programming logic. Since then, I have been using macros for ~20 years and Excel for ~30. Even doing these macros for you required lots of Google searches on this forum and several others. I will dig and dig and then try stuff until I get it to work. I usually have a basic idea of how to get there, but I often need to look up the syntax. What you listed for this second problem was perfect though. You clearly outlined the steps that needed to be followed and it made the solution fairly easy because I could solve it in small pieces.

Good luck and reach out if I can ever help again.

Hopefully after a lot of studying and many many many years, I'll be able to help you with a VBA in here as well hahah. Thank you once again for all your help.