[Solved] VBA code for submitting details in two sheets of excel

[sivanagaraju]

I tried to create an excel form for submitting the details which are to be entered in seperate sheets using youtube.
I need the all details to be entered in the sheet "Total" and also to respective sheets as selected in "Type"
I am able to enter the details in respective sheets as selected in "Type" but not in the sheet "Total"
Please help so that I could enter in both the sheets.

 

[shamimarita]

Hello,

You’ve done the hard part already (writing to the sheet chosen in E6: Type). To also log the same entry to Total, write the values once into an array and append that row to both sheets. The macro below is a drop-in replacement that avoids Select/Activate (more reliable) and validates the Type sheet name.

Option Explicit
Private Function SheetExists(ByVal sName As String) As Boolean
    On Error Resume Next
    SheetExists = Not ThisWorkbook.Worksheets(sName) Is Nothing
    On Error GoTo 0
End Function

Public Sub ENTRY()
    Dim wsEntry As Worksheet, wsTotal As Worksheet, wsType As Worksheet
    Dim typeName As String
    Dim arr As Variant
    Dim rowType As Long, rowTot As Long

    Set wsEntry = ThisWorkbook.Worksheets("ENTRY")
    Set wsTotal = ThisWorkbook.Worksheets("Total")

    ' Read form values from ENTRY
    ' Order written to columns B:E:  E4, E6 (Type), E8, E10
    arr = Array(wsEntry.Range("E4").Value, _
                wsEntry.Range("E6").Value, _
                wsEntry.Range("E8").Value, _
                wsEntry.Range("E10").Value)

    ' Validate Type and get the destination sheet
    typeName = CStr(wsEntry.Range("E6").Value)
    If Len(typeName) = 0 Then
        MsgBox "Please choose a Type in cell E6.", vbExclamation
        Exit Sub
    End If
    If Not SheetExists(typeName) Then
        MsgBox "The sheet """ & typeName & """ does not exist.", vbCritical
        Exit Sub
    End If
    Set wsType = ThisWorkbook.Worksheets(typeName)

    ' Append to the Type-selected sheet
    rowType = wsType.Cells(wsType.Rows.Count, "B").End(xlUp).Row + 1
    wsType.Cells(rowType, "B").Resize(1, UBound(arr) + 1).Value = arr
    wsType.Cells(rowType, "A").Value = Now   ' optional timestamp in col A

    ' Also append to the Total sheet
    rowTot = wsTotal.Cells(wsTotal.Rows.Count, "B").End(xlUp).Row + 1
    wsTotal.Cells(rowTot, "B").Resize(1, UBound(arr) + 1).Value = arr
    wsTotal.Cells(rowTot, "A").Value = Now   ' optional timestamp in col A

    ' Clear the form inputs
    wsEntry.Range("E4,E6,E8,E10").ClearContents

    MsgBox "Entry saved to """ & typeName & """ and ""Total"".", vbInformation
End Sub

Public Sub RESET1()
    ThisWorkbook.Worksheets("ENTRY").Range("E4,E6,E8,E10").ClearContents
End Sub

This keeps your layout (writing to columns B:E) and simply ensures the same row goes to Total as well as the chosen Type sheet.
If your “Total” sheet needs extra columns (e.g., a running ID), say the word and I’ll add it.

 

[sivanagaraju]

Thank you for the solution for the problem

 

[shamimarita]

You are most welcome. Thanks for your feedback and appreciation. Keep helping each other to make the community stronger.

 

[sivanagaraju]

Hello,

You’ve done the hard part already (writing to the sheet chosen in E6: Type). To also log the same entry to Total, write the values once into an array and append that row to both sheets. The macro below is a drop-in replacement that avoids Select/Activate (more reliable) and validates the Type sheet name.

Option Explicit
Private Function SheetExists(ByVal sName As String) As Boolean
    On Error Resume Next
    SheetExists = Not ThisWorkbook.Worksheets(sName) Is Nothing
    On Error GoTo 0
End Function

Public Sub ENTRY()
    Dim wsEntry As Worksheet, wsTotal As Worksheet, wsType As Worksheet
    Dim typeName As String
    Dim arr As Variant
    Dim rowType As Long, rowTot As Long

    Set wsEntry = ThisWorkbook.Worksheets("ENTRY")
    Set wsTotal = ThisWorkbook.Worksheets("Total")

    ' Read form values from ENTRY
    ' Order written to columns B:E:  E4, E6 (Type), E8, E10
    arr = Array(wsEntry.Range("E4").Value, _
                wsEntry.Range("E6").Value, _
                wsEntry.Range("E8").Value, _
                wsEntry.Range("E10").Value)

    ' Validate Type and get the destination sheet
    typeName = CStr(wsEntry.Range("E6").Value)
    If Len(typeName) = 0 Then
        MsgBox "Please choose a Type in cell E6.", vbExclamation
        Exit Sub
    End If
    If Not SheetExists(typeName) Then
        MsgBox "The sheet """ & typeName & """ does not exist.", vbCritical
        Exit Sub
    End If
    Set wsType = ThisWorkbook.Worksheets(typeName)

    ' Append to the Type-selected sheet
    rowType = wsType.Cells(wsType.Rows.Count, "B").End(xlUp).Row + 1
    wsType.Cells(rowType, "B").Resize(1, UBound(arr) + 1).Value = arr
    wsType.Cells(rowType, "A").Value = Now   ' optional timestamp in col A

    ' Also append to the Total sheet
    rowTot = wsTotal.Cells(wsTotal.Rows.Count, "B").End(xlUp).Row + 1
    wsTotal.Cells(rowTot, "B").Resize(1, UBound(arr) + 1).Value = arr
    wsTotal.Cells(rowTot, "A").Value = Now   ' optional timestamp in col A

    ' Clear the form inputs
    wsEntry.Range("E4,E6,E8,E10").ClearContents

    MsgBox "Entry saved to """ & typeName & """ and ""Total"".", vbInformation
End Sub

Public Sub RESET1()
    ThisWorkbook.Worksheets("ENTRY").Range("E4,E6,E8,E10").ClearContents
End Sub

This keeps your layout (writing to columns B:E) and simply ensures the same row goes to Total as well as the chosen Type sheet.
If your “Total” sheet needs extra columns (e.g., a running ID), say the word and I’ll add it.

After submitting the details in the entry page, the details are being copied to respective sheet and total sheet also. But it is being copied after the table. excel is also being attached.

 

[shamimarita]

Hello,

It sounds like the data is being pasted below the table because the code is not detecting the table’s data range and is instead using the next empty row on the worksheet.

To fix this, make sure your VBA is adding rows inside the Excel Table, not outside it.

You can replace your paste section with something like this:

Dim tbl As ListObject
Set tbl = Sheets("YourSheetName").ListObjects("Table1")

'Add a new row inside the table
Dim newRow As ListRow
Set newRow = tbl.ListRows.Add

'Write values into the new row
newRow.Range(1, 1).Value = Me.TextBox1.Value
newRow.Range(1, 2).Value = Me.TextBox2.Value
'…and so on

Tables automatically expand, so this ensures all new entries go inside the table, not below it.