Excel/VBA Summary sheet - overwriting data - excel

Question

first of all a thank you for previous help! You learned me more and still am learning everyday to code better :)
In the previous posts I wrote about having a userform for some input. Then it searches for the persons name in all the sheets in the workbook and writes the data as specified. In my workbook I would like to dedicate 1 sheet to summarize from all other sheets.
Now here is where an error occurs. The data is written down on the summary sheet, but when I select another name, the first row (lRow, 3) gets re-written.
I think that my mistake occurs with the lastrow statement. I have tried the .Range("C"...) version to find the last used row. Now it also finds the last used row, but also somehow overwrites the first row with values other then the selected name
Dim lRow As Long
Dim Ws As Worksheet
Dim Naam As String
Dim xTo As String
Dim xBCC As String
With Me.ComboBox1
i = .ListIndex
If i < 0 Then
MsgBox "Er is niemand geselecteerd.", vbExclamation
Exit Sub
End If
xTo = .List(i, 1)
xBCC = .List(i, 2)
Naam = .List(i, 3)
End With
Set Ws = Worksheets(ComboBox1.Value)
lRow = Ws.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
With Ws
.Cells(lRow, 3).Value = Format(Date, "DD-MM-YYYY") & " " & Format(Time, "HH:MM")
If chk1.Value Then .Cells(lRow, 5).Value = 1
If chk1.Value = False Then .Cells(lRow, 5).Value = 0
If chk2.Value Then .Cells(lRow, 6).Value = 1
If chk2.Value = False Then .Cells(lRow, 6).Value = 0
If chk3.Value Then .Cells(lRow, 7).Value = 1
If chk3.Value = False Then .Cells(lRow, 7).Value = 0
If chk4.Value Then .Cells(lRow, 8).Value = 1
If chk4.Value = False Then .Cells(lRow, 8).Value = 0
If chk5.Value Then .Cells(lRow, 9).Value = 1
If chk5.Value = False Then .Cells(lRow, 9).Value = 0
If chk6.Value Then .Cells(lRow, 10).Value = 1
If chk6.Value = False Then .Cells(lRow, 10).Value = 0
If chk7.Value Then .Cells(lRow, 11).Value = 1
If chk7.Value = False Then .Cells(lRow, 11).Value = 0
If chk8.Value Then .Cells(lRow, 12).Value = 1
If chk8.Value = False Then .Cells(lRow, 12).Value = 0
If chk9.Value Then .Cells(lRow, 13).Value = 1
If chk9.Value = False Then .Cells(lRow, 13).Value = 0
If 10.Value Then .Cells(lRow, 14).Value = 1
If 10.Value = False Then .Cells(lRow, 14).Value = 0
If chk11.Value Then .Cells(lRow, 15).Value = 1
If chk11.Value = False Then .Cells(lRow, 15).Value = 0
If chk12.Value Then .Cells(lRow, 16).Value = 1
If chk12.Value = False Then .Cells(lRow, 16).Value = 0
If chk13.Value Then .Cells(lRow, 17).Value = 1
If chk13.Value = False Then .Cells(lRow, 17).Value = 0
End With
Set Ws = Worksheets("Team totaal")
With Ws
.Cells(lRow, 3).Value = Naam
.Cells(lRow, 4).Value = Format(Date, "DD-MM-YYYY") & " " & Format(Time, "HH:MM")
If chk1.Value Then .Cells(lRow, 6).Value = 1
If chk1.Value = False Then .Cells(lRow, 6).Value = 0
If chk2.Value Then .Cells(lRow, 7).Value = 1
If chk2.Value = False Then .Cells(lRow, 7).Value = 0
If chk3.Value Then .Cells(lRow, 8).Value = 1
If chk3.Value = False Then .Cells(lRow, 8).Value = 0
If chk4.Value Then .Cells(lRow, 9).Value = 1
If chk4.Value = False Then .Cells(lRow, 9).Value = 0
If chk5.Value Then .Cells(lRow, 10).Value = 1
If chk5.Value = False Then .Cells(lRow, 10).Value = 0
If chk6.Value Then .Cells(lRow, 11).Value = 1
If chk6.Value = False Then .Cells(lRow, 11).Value = 0
If chk7.Value Then .Cells(lRow, 12).Value = 1
If chk7.Value = False Then .Cells(lRow, 12).Value = 0
If chk8.Value Then .Cells(lRow, 13).Value = 1
If chk8.Value = False Then .Cells(lRow, 13).Value = 0
If chk9.Value Then .Cells(lRow, 14).Value = 1
If chk9.Value = False Then .Cells(lRow, 14).Value = 0
If chk10.Value Then .Cells(lRow, 15).Value = 1
If chk10.Value = False Then .Cells(lRow, 15).Value = 0
If chk11.Value Then .Cells(lRow, 16).Value = 1
If chk11.Value = False Then .Cells(lRow, 16).Value = 0
If chk12.Value Then .Cells(lRow, 17).Value = 1
If chk12.Value = False Then .Cells(lRow, 17).Value = 0
If chk13.Value Then .Cells(lRow, 18).Value = 1
If chk13.Value = False Then .Cells(lRow, 18).Value = 0
End With
Maybe this is not the correct way to set up a summary sheet and someone has a more efficient way to do this. Any help is welcome

Answer 1

The best way to approach solving a problem with code is to break it down to very simple functions and sub routines.
Here is my thought processes.
We are probably going to be referring to the "Team totaal" worksheet in many of of the macros. Ws is meaningless. I would change the code name of the worksheet to wsTeamTotaal. but this also works:
Function wsTeamTotaal() As Worksheet
Set wsTeamTotaal = ThisWorkbook.Worksheets("Team totaal")
End Function
Next I know that I need to target the next available row in wsTeamTotaal. This should do it.
Function TeamTotalNewRow() As Range
With wsTeamTotaal
Set TeamTotalNewRow = .Cells(.Rows.Count, 3).End(xlUp).Offset(1, 0)
End With
End Function
Do I write a 60 line script to test it? Hell no!! This function selects the first cell in the new row.
Sub GotoTeamTotalNewRow()
Application.Goto TeamTotalNewRow
End Sub
Okay now I write a script to gather all the information and append the row, right? Wrong! Writing a function that accepts variable number of arguments using a ParamArray simplifies the process. Now I can append 1 value of 60+ values without any major modifications.
Sub AppendTeamTotaalRow(ParamArray Args() As Variant)
With TeamTotalNewRow
.Resize(1, UBound(Args) + 1).Value = Args
End With
End Sub
So time to spend a hour writing a userform, gather the data and then testing the append method. Of course not. What's easier to test, a userform packed full of functionality and controls or one simple sub routine?
Sub TestAddNewTeamTotalRow()
Dim TimeStamp As String
TimeStamp = Format(Date, "DD-MM-YYYY") & " " & Format(Time, "HH:MM")
AppendTeamTotaalRow TimeStamp, True, False, True, False
End Sub
Notice that I broke this problem do to it's simplest terms and solved each problem separately. We now have 2 functions, a sub routine and two tests. Each routine performs a single task and no routine has more than 5 lines. Simplify, simplify, simplify, it's that simple.
Complete Code
Function TeamTotalNewRow() As Range
With wsTeamTotaal
Set TeamTotalNewRow = .Cells(.Rows.Count, 3).End(xlUp).Offset(1, 0)
End With
End Function
Function wsTeamTotaal() As Worksheet
Set wsTeamTotaal = ThisWorkbook.Worksheets("Team totaal")
End Function
Sub GotoTeamTotalNewRow()
Application.Goto TeamTotalNewRow
End Sub
Sub AppendTeamTotaalRow(ParamArray Args() As Variant)
With TeamTotalNewRow
TeamTotalNewRow.Resize(1, UBound(Args) + 1).Value = Args
End With
End Sub
Sub TestAddNewTeamTotalRow()
Dim TimeStamp As String
TimeStamp = Format(Date, "DD-MM-YYYY") & " " & Format(Time, "HH:MM")
AppendTeamTotaalRow TimeStamp, True, False, True, False
End Sub