Excel/VBA Summary sheet - overwriting data-CodePudding

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

CodePudding user response：

The best way to approach solving a problem with code is to break it down to very simple functions and sub routines.

Append Row Demo

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
        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