Delete extra row

Question

I have a document with 95 people, where I fill in 1 row for each of them for each day.
One day I fill in 91 rows, the second day 89 rows, the third 94... (each day a different number of rows to fill in).
After that entry, for each person I need to have 24 filled in rows for the last 24 days when I entered data.
The next day I enter data for 92 people, for those 92 people I will have 25 filled in rows (the 25th row is extra and I have to delete it, now I do it manually).
How can I delete that 25th row at once for all 92 people, so that I have 24 rows left for everyone?

kidd_ip · Answer

How about this:
&nbsp;
Sub DeleteExtraRows()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dict As Object
    Dim i As Integer
    Dim personID As String
    
    Set ws = ThisWorkbook.Sheets("YourSheetName") ' Change to your actual sheet name
    Set dict = CreateObject("Scripting.Dictionary")
    
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' Assumes IDs are in column A
    
    For i = lastRow To 1 Step -1
        personID = ws.Cells(i, 1).Value
        If Not dict.exists(personID) Then
            dict.Add personID, 0
        End If
        
        dict(personID) = dict(personID) + 1
        
        If dict(personID) &gt; 24 Then
            ws.Rows(i).Delete
        End If
    Next i
End Sub
&nbsp;

Forum Discussion

Delete extra row

1 Reply

Resources