Selected Answer
Hello Omaran,
Your existing code just needs to be made dynamic.
In my code below, it first checks it the name in TB3 already exists. If it does, it updates the data for that record. If the name does not exist, it creates a new record below the last record on the sheet.
Updated Apr. 21/24
Ah yes, I had forgotten to consider the "blank sheet" scenario.
This latest update takes into consideration that the worksheet may be blank.
File ASDD Rev2 is attached with the update code.
First the UserForm code will determine if the sheet is blank or has existing entries and will call the appropriate macrco.
Private Sub CommandButton1_Click()
' code revised by WillieD24, April 2024
' code will determine if all textboxes are filled,
' is this the first entry to the sheet, is this data an update to
' an existing name, or is this a new entry to add to the listings
Dim TBnbr As Long
Dim TBcnt As Long
Dim TB3name As String ' name entered into textbox3
Dim TB3row As Long ' row where TB3name is found
Dim LR As Long ' last row with data in Col A
Sheets("SS").Select
' check that all textboxes are filled
For TBnbr = 1 To 6
If UserForm1.Controls("TextBox" & TBnbr) = "" Then
TBcnt = TBcnt + 1
End If
Next
If TBcnt <> 0 Then ' at least one textbox is empty
MsgBox "All fields must be filled"
Exit Sub ' at least one textbox is empty
End If
LR = Cells(Rows.Count, 1).End(xlUp).Row ' last used row in Col A
If LR = 1 Then
Call First_Entry
Else
Call Additional_Entry
End If
' close userform
Unload UserForm1
End Sub
Then one of two macros is called: the "First_Entry" macro, or the "Additional_Entry" macro.
Sub First_Entry()
' Written by WillieD24, April 2024
' code will format first 4 rows and add UserForm1 data
Dim TBnbr As Long
Dim TBcnt As Long
Dim TB3name As String ' name entered into textbox3
Dim TB3row As Long ' row where TB3name is found
Dim LR As Long ' last row with data in Col A
' format column widths
Columns("A:B").ColumnWidth = 14
Columns("C").ColumnWidth = 24
Columns("D").ColumnWidth = 14
' format cell alignment
Range("A1:D4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
' format cell font
With Selection.Font
.Name = "Calibri"
.Size = 10
End With
' format cell borders
Range("A1:D2, C3:D4").Select
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
' add cell fill colour, make font bold
Range("A1:D1, C3:C4").Interior.Color = RGB(255, 102, 0)
Range("A1:D1, C3:C4").Font.Bold = True
' add UserForm data
' enter headers
Range("A1").Value = UserForm1.Label1.Caption
Range("B1").Value = UserForm1.Label2.Caption
Range("C1").Value = UserForm1.Label3.Caption
Range("D1").Value = UserForm1.Label4.Caption
Range("C3").Value = UserForm1.Label5.Caption
Range("C4").Value = UserForm1.Label6.Caption
' enter data
Range("A2").Value = UserForm1.TextBox1.Value
Range("B2").Value = UserForm1.TextBox2.Value
Range("C2").Value = UserForm1.TextBox3.Value
Range("D2").Value = UserForm1.TextBox4.Value
Range("D3").Value = UserForm1.TextBox5.Value
Range("D4").Value = UserForm1.TextBox6.Value
Range("A1").Select
' close userform
Unload UserForm1
End Sub
Sub Additional_Entry()
' Written by WillieD24, April 2024
' code will update data for existing name or
' create new entry and add the new data
Dim LR As Long ' last row with data in Col A
Dim TB3name As String ' name entered into textbox3
Dim TB3row As Long ' row where TB3name is found
Dim CopyRow As Long
If Application.CountIf([C:C], UserForm1.TextBox3.Value) > 0 Then
' name in textbox3 already exists in sheet
' update data for existing name
LR = Cells(Rows.Count, 1).End(xlUp).Row ' last used row in Col A
TB3name = UserForm1.TextBox3.Value
' get row number for existing name
TB3row = 1 + WorksheetFunction.Match(TB3name, Range("C2:C" & LR), 0)
' update data from TB1, TB2, TB4, TB5, TB6
Cells(TB3row, 1).Value = UserForm1.TextBox1.Value
Cells(TB3row, 2).Value = UserForm1.TextBox2.Value
Cells(TB3row, 4).Value = UserForm1.TextBox4.Value
Cells(TB3row + 1, 4).Value = UserForm1.TextBox5.Value
Cells(TB3row + 2, 4).Value = UserForm1.TextBox6.Value
Else ' create new entry for new name
LR = Cells(Rows.Count, 1).End(xlUp).Row ' last used row in Col A
CopyRow = LR + 4
' copy data block structure/formatting
Rows("1:4").Select
Selection.Copy
Rows(CopyRow).Select
ActiveSheet.Paste
Cells(LR + 9, 1).Select
Application.CutCopyMode = False
' enter data
Cells(LR + 5, 1).Value = UserForm1.TextBox1.Value
Cells(LR + 5, 2).Value = UserForm1.TextBox2.Value
Cells(LR + 5, 3).Value = UserForm1.TextBox3.Value
Cells(LR + 5, 4).Value = UserForm1.TextBox4.Value
Cells(LR + 6, 4).Value = UserForm1.TextBox5.Value
Cells(LR + 7, 4).Value = UserForm1.TextBox6.Value
End If
' close UserForm
Unload UserForm1
End Sub
If this solves things for you, please mark my answer as Selected.
Cheers :-)
