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