Search code examples
excelvbauserform

Excel VBA: saving partial data creates new row each time. How to update if row has values


I have a simple form that allows to enter counts at different times of the day.

My form loads the values of the last row in the table to the UserForm so that whoever opens the form to enter the next count gets the previous values placed in the form:

Private Sub UserForm_Initialize()
Dim lr As Long
lr = ActiveSheet.Range("A1").End(xlDown).Row
eightWkd.Value = Cells(lr, 3)
nineWkd.Value = Cells(lr, 4)
ten30Wkd.Value = Cells(lr, 6)
noonWkd.Value = Cells(lr, 8)
one30Wkd.Value = Cells(lr, 10)
threeWkd.Value = Cells(lr, 12)
four30Wkd.Value = Cells(lr, 14)
sixWkd.Value = Cells(lr, 15)

But, each submission creates a new row. screenshot of excel sheet

Here is my code for my submit button, setting the values. Changing the loaded values works. I find the first empty row

Private Sub SubmitButton_Click()
Dim ws As Worksheet
Set ws = Worksheets("daily_count")
Dim lr As Long, varDay As Long
With ws
    lr = .Cells(.Rows.Count, varDay).End(xlUp).Offset(1, 0).Row
    .Cells(lr, 1).Value = Me.DateWkd.Value
    .Cells(lr, 2).Value = Me.DayWkd.Value
    .Cells(lr, 3).Value = Me.eightWkd.Value
    .Cells(lr, 4).Value = Me.nineWkd.Value
    .Cells(lr, 6).Value = Me.ten30Wkd.Value
    .Cells(lr, 8).Value = Me.noonWkd.Value
    .Cells(lr, 10).Value = Me.one30Wkd.Value
    .Cells(lr, 12).Value = Me.threeWkd.Value
    .Cells(lr, 14).Value = Me.four30Wkd.Value
    .Cells(lr, 15).Value = Me.sixWkd.Value

I tried the following logic, to choose between the last existing row, and a new row, based on whether the date value (column A) is set, but it didn't work.

If ActiveSheet.Range("A1") = Format(Date, "mm/dd/yy") Then
r = ActiveSheet.Range("A1").End(xlDown).Row
Else
r = .Cells(.Rows.Count, varDay).End(xlUp).Offset(1, 0).Row
End If

So, how do I update cells in the row instead of creating a new row?


Solution

  • How about using the .Find method to find the row with the current date and then update the values of that row if found, and if not found then add the values to the next free row:

    Private Sub SubmitButton_Click()
    Dim ws As Worksheet
    Set ws = Worksheets("daily_count")
    Dim lr As Long, varDay As Long, rng as Range
    FindVal = Format(Date, "mm/dd/yy")
    Set Rng = ws.Range("A:A").Find(What:=FindVal, lookat:=xlWhole)
    If Not Rng Is Nothing Then
        With ws
            .Cells(Rng.Row, 1).Value = Me.DateWkd.Value
            .Cells(Rng.Row, 2).Value = Me.DayWkd.Value
            .Cells(Rng.Row, 3).Value = .Cells(Rng.Row, 3).Value + Me.eightWkd.Value
            .Cells(Rng.Row, 4).Value = .Cells(Rng.Row, 4).Value + Me.nineWkd.Value
            .Cells(Rng.Row, 6).Value = .Cells(Rng.Row, 6).Value + Me.ten30Wkd.Value
            .Cells(Rng.Row, 8).Value = .Cells(Rng.Row, 8).Value + Me.noonWkd.Value
            .Cells(Rng.Row, 10).Value = .Cells(Rng.Row, 10).Value + Me.one30Wkd.Value
            .Cells(Rng.Row, 12).Value = .Cells(Rng.Row, 12).Value + Me.threeWkd.Value
            .Cells(Rng.Row, 14).Value = .Cells(Rng.Row, 14).Value + Me.four30Wkd.Value
            .Cells(Rng.Row, 15).Value = .Cells(Rng.Row, 15).Value + Me.sixWkd.Value
        End With
    Else
        With ws
            lr = .Cells(.Rows.Count, varDay).End(xlUp).Offset(1, 0).Row
            .Cells(lr, 1).Value = Me.DateWkd.Value
            .Cells(lr, 2).Value = Me.DayWkd.Value
            .Cells(lr, 3).Value = Me.eightWkd.Value
            .Cells(lr, 4).Value = Me.nineWkd.Value
            .Cells(lr, 6).Value = Me.ten30Wkd.Value
            .Cells(lr, 8).Value = Me.noonWkd.Value
            .Cells(lr, 10).Value = Me.one30Wkd.Value
            .Cells(lr, 12).Value = Me.threeWkd.Value
            .Cells(lr, 14).Value = Me.four30Wkd.Value
            .Cells(lr, 15).Value = Me.sixWkd.Value
        End With
    End If
    End Sub