I am wanting to add a sheet using the first 2 cells of a table as it's name. For example, in the following table, Button 1 would create a sheet named "Doe,John".

I am wanting to add a sheet using the first 2 cells of a table as it's name. For example, in the following table, Button 1 would create a sheet named "Doe,John".

The button's Code looks like the following currently, bringing up an input box to manually put in a name, opening it, then sorting the worksheets alphabetically. If the sheet already exists, it will only open the sheet:

Sub TestSheetCreate()
    Dim newSheetName As String
    Dim checkSheetName As String
    Dim I As Integer
    Dim J As Integer
    
    newSheetName = Application.InputBox("Input Sheet Name:", "Excel 10 Tutorial", "", , , , , 2)

    On Error Resume Next

    checkSheetName = Worksheets(newSheetName).Name

    If checkSheetName = "" Then
        Worksheets.Add.Name = newSheetName
    Else
        Sheets(checkSheetName).Select
    End If

    For I = 1 To Sheets.Count - 1
        For J = I + 1 To Sheets.Count
            If UCase(Sheets(I).Name) > UCase(Sheets(J).Name) Then
                Sheets(J).Move Before:=Sheets(I)
            End If
        Next J
    Next I
    
End Sub

How would I replace the InputBox with an automatic name generated from the first 2 cells of the row the button is located?

• excel
• vba
• excel-2021

• 1 Please specify the type of buttons used on the worksheet: ActiveX control, Form control, or a shape/picture. – taller Commented Feb 14 at 0:27
• I am currently using a Form Control, however if there is an easier implementation through other types I can adjust my worksheet. I will try your picture first and update accordingly. Image – Caleb Phelps Commented Feb 14 at 0:58

1 Answer 1

If a shape/picture is used as the button on worksheet.

Sub TestSheetCreate()
    Dim newSheetName As String
    Dim checkSheetName As String
    Dim I As Integer
    Dim J As Integer
'    newSheetName = Application.InputBox("Input Sheet Name:", "Excel 10 Tutorial", "", , , , , 2)
    With ActiveSheet.Shapes(Application.Caller).TopLeftCell
        newSheetName = .Offset(, -2) & "," & .Offset(, -1)
    End With
    On Error Resume Next
    checkSheetName = Worksheets(newSheetName).Name
    If checkSheetName = "" Then
        Worksheets.Add.Name = newSheetName
    Else
        Sheets(checkSheetName).Select
    End If
    For I = 1 To Sheets.Count - 1
        For J = I + 1 To Sheets.Count
            If UCase(Sheets(I).Name) > UCase(Sheets(J).Name) Then
                Sheets(J).Move Before:=Sheets(I)
            End If
        Next J
    Next I
End Sub