Rows delete formula as per range of cell values with counter to delete # rows

Rows delete formula as per range of cell values with counter to define how many rows to be deleted

Rows delete formula as per range of cell values with counter to define how many rows to be deleted

Hi,

I have DB with 50000 rows i have specific cell value A:A

MAX cell value countIF of each specific value of A:A = 31. (Let say Abraham name came in 31 rows in column A:A similary steve also 31 no value will NOT go above 31 as system rule.

Requirement :

I want to use cell value A:A as reference rage for row deletion and would like to delete 5 rows from DB per cell Value


Example

Cell Range: A:A
How many rows you would like to delete : 4 (lets say 4 so it will delete 4 rows as per cell value) like out of 32 values 4 will be deleted from peter and similarly 4 will be deleted from Abraham.

Task:

SO COUNTIF of cell value 31 and new request for specific customer came i am able to delete rows with counter lets say 4 to add four new records in DB.

Bets of Luck!

I love it if its MACRO in vbscripts

Just for clarification: You want to delete the requested number of rows from each name that has 31 occurrences in column A. If a name has less than 31 occurrences, then you don't want to delete any rows. Is this correct?

The macro assumes that there are no empty cells in column A and that the data is sorted according to name.

Sub DelRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    Dim fVisRow As Long
    Dim response As Long
    response = InputBox("Please enter the number of rows to delete.")
    Sheets("Sheet1").Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1:A" & LastRow), Unique:=True
    Set rnguniques = Sheets("Sheet1").Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
    If Sheets("Sheet1").FilterMode Then Sheets("Sheet1").ShowAllData
    For Each rng In rnguniques
        If WorksheetFunction.CountIf(Range("A2:A" & LastRow), rng) >= 31 Then
            Range("A1:A" & LastRow).AutoFilter Field:=1, Criteria1:=rng
            fVisRow = Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
            Range("A2:A" & LastRow).Rows(fVisRow & ":" & fVisRow + response - 1).EntireRow.Delete
        End If
    Next rng
    If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

You are very welcome.