How to delete certain rows

[Ron_N]

Hi,

I am new to VBA. I want a code which needs to delete the count of rows which has exceeded the value of c. Suppose c stores a number, which is the number of rows to be kept and the rest of the rows deleted. I also want my header row to be the way it is. It should not be deleted.

Basically i want this
(Total number of rows - (c number of rows + the header row)).delete

I am using the following but not getting the desired result. Please help me out. Its urgent. I am stuck.

Rows .Resize(ActiveSheet.Range("a2", ActiveSheet.Range("a2").End(xlDown)).Count - c).Delete



Please assist.

Thank you,
Ron

 

[Richard Schollar]

Hi Ron

Which rows do you want to keep? Those at the top of your data range or those at the bottom (excluding headers)?

 

[Ron_N]

Hi Richard,

Thank you so much for the response. I wanted to keep the rows at the top of the data range including the header.

Thank you.
Ron

 

[Richard Schollar]

Try:

Range("A2:A" & Cells(Rows.Count,"A").End(xlUp).Row).Offset(c).EntireRow.Delete

You need to have assigned a value to c before you run this otherwise the range won't be offset and all your originals will be deleted.

 

[Ron_N]

Thank you Richard. You always come as a messiah for me. This code works perfect.

Suppose i apply autofilter and get the following rows: the first is the heading which is row number 1. The second & third row after applying filter is row number 12 and 13 for Research Type = Transaction History.

<TABLE style="WIDTH: 354pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=472 border=0><COLGROUP><COL style="WIDTH: 63pt; mso-width-source: userset; mso-width-alt: 3072" width=84><COL style="WIDTH: 81pt; mso-width-source: userset; mso-width-alt: 3949" width=108><COL style="WIDTH: 36pt; mso-width-source: userset; mso-width-alt: 1755" width=48><COL style="WIDTH: 138pt; mso-width-source: userset; mso-width-alt: 6729" width=184><COL style="WIDTH: 36pt; mso-width-source: userset; mso-width-alt: 1755" width=48><TBODY><TR style="HEIGHT: 27.75pt; mso-height-source: userset" height=37><TD class=xl69 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; WIDTH: 63pt; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 27.75pt; BACKGROUND-COLOR: transparent" width=84 height=37>Req ID</TD><TD class=xl69 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 81pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" width=108>GSS Number</TD><TD class=xl69 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 36pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" width=48>Tier </TD><TD class=xl69 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 138pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" width=184>Research Type</TD><TD class=xl69 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 36pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" width=48>Rush</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl67 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; WIDTH: 63pt; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" width=84 height=17>3</TD><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; WIDTH: 81pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" align=right width=108>3567</TD><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; WIDTH: 36pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" width=48>JHU</TD><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; WIDTH: 138pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" width=184>Transaction History</TD><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; WIDTH: 36pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" width=48>No</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl67 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; WIDTH: 63pt; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" width=84 height=17>4</TD><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; WIDTH: 81pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" align=right width=108>8765</TD><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; WIDTH: 36pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" width=48>KGU</TD><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; WIDTH: 138pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" width=184>Transaction History</TD><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; WIDTH: 36pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" width=48>No</TD></TR></TBODY></TABLE>

I wanted the below code to be applied from the first visible row after applying autofilter. (in this case row number 12)

Range("A2:A" & Cells(Rows.Count,"A").End(xlUp).Row).Offset(c).EntireRow.Delete
-------------------
Please advice what modifications needs to be done on this code.

Thanks in advance.
Ron

 

[Richard Schollar]

Hi Ron

Does that mean that you wish to retain c rows of the filtered data and delete the remaining visible rows (leaving all the rows which have been filtered out, ie hidden, behind)?

 

[Ron_N]

Yes Richard,

this is exactly what i want.


Thank you,
Ron

 

[Richard Schollar]

Here is one way to do that:

Sub Ron()

Dim rngData As Range, rngFilt As Range, cell As Range, rngStartDeleteHere As Range
Dim c As Long, cnt As Long

c = 10  'number of filtered records to retain

Set rngData = ActiveSheet.AutoFilter.Range

With rngData
    Set rngFilt = .Columns(1).SpecialCells(xlCellTypeVisible)
    For Each cell In rngFilt
        cnt = cnt + 1
        If cnt = (c + 1 + 1) Then '(add 1 to c to include header, and another one to make sure you have retained all records reqd)
            Set rngStartDeleteHere = cell
            Exit For
        End If
    Next cell
      rngStartDeleteHere.Resize(.Rows.Count).EntireRow.SpecialCells(xlCellTypeVisible).Delete
End With
End Sub

 

[Ron_N]

Thank you Richard. This helped me from drowning

 

[Richard Schollar]

Hi Ron

Following your PM, I suspect that the problem is caused by not initializing variable cnt between loops of i - try this amended code instead:

Set dic = CreateObject("Scripting.Dictionary")
Set rngAllValues = Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)
For Each cell In rngAllValues
If Not dic.exists(cell.Value) Then _
dic.Add cell.Value, cell.Value
Next cell
arrUniqueValues = dic.Keys
For i = LBound(arrUniqueValues) To UBound(arrUniqueValues)
Range("A1:W1").AutoFilter Field:=4, Criteria1:=arrUniqueValues(i)

lcount = Sheets("Data_sample").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count
lcount_1 = lcount - 1

VarRateTable = Sheets("Work Type-allocation").Range("A1:B65536")

vt = Application.WorksheetFunction.Vlookup(Cells(2, 4).Value, VarRateTable, 2, 0)
b = lcount_1 * vt
ab = Application.RoundUp(b, 0)
c = ab

Set rngData = ActiveSheet.AutoFilter.Range
With rngData
Set rngFilt = .Columns(1).SpecialCells(xlCellTypeVisible)

cnt = 0  'initialize variable cnt

For Each cell_n In rngFilt
cnt = cnt + 1
If cnt = (c + 1 + 1) Then '(add 1 to c to include header, and another one to make sure you have retained all records reqd)
Set rngStartDeleteHere = cell_n

Exit For
End If
Next cell_n

On Error Resume Next
rngStartDeleteHere.Resize(.Rows.Count).EntireRow.SpecialCells(xlCellTypeVisible).Delete

End With

Next i