Delete entire row

Panoos64

Well-known Member
Joined
Mar 1, 2014
Messages
786
All hi, i am kindly require to provide me a VBA code so that to run through col. "A" and where find the description "NET COST OF SALES/(FOOD)" twice, should delete once entire row but the second one. I present below original data and expected result. Thank you all in advance


Original Data
A
104 NET COST OF SALES/(FOOD)
105
106 NET COST OF SALES/(FOOD)


Expected result
A
104 NET COST OF SALES/(FOOD)
105
 
Last edited:

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
5,034
Office Version
2019
Platform
Windows
Code:
Option Explicit


Sub DeleteDuplicateRows()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DeleteDuplicateRows
' This will delete duplicate records, based on the Active Column. That is,
' if the same value is found more than once in the Active Column, all but
' the first (lowest row number) will be deleted.
'
' To run the macro, select the entire column you wish to scan for
' duplicates, and run this procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


    Dim r As Long
    Dim n As Long
    Dim v As Variant
    Dim rng As Range


    On Error GoTo EndMacro
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual




    Set rng = Application.Intersect(ActiveSheet.UsedRange, _
                                    ActiveSheet.Columns(ActiveCell.Column))


    Application.StatusBar = "Processing Row: " & Format(rng.Row, "#,##0")


    n = 0
    For r = rng.Rows.Count To 2 Step -1
        If r Mod 500 = 0 Then
            Application.StatusBar = "Processing Row: " & Format(r, "#,##0")
        End If


        v = rng.Cells(r, 1).Value
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString.
        ' Rather than pass in the variant, you need to pass in vbNullString explicitly.
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        If v = vbNullString Then
            If Application.WorksheetFunction.CountIf(rng.Columns(1), vbNullString) > 1 Then
                rng.Rows(r).EntireRow.Delete
                'rng.Rows(r).EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
                n = n + 1
            End If
        Else
            If Application.WorksheetFunction.CountIf(rng.Columns(1), v) > 1 Then
                rng.Rows(r).EntireRow.Delete
                'rng.Rows(r).EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
                n = n + 1
            End If
        End If
    Next r


EndMacro:


    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Duplicate Rows Deleted: " & CStr(n)




End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,247
Office Version
365
Platform
Windows
Another way
Code:
Sub panoose64()
    Dim Fnd As Range
    Dim Txt As String
    
    Txt = "Net cost of sales/(food)"
    Set Fnd = Range("A:A").Find(Txt, , , xlPart, , , False, , False)
    
   Fnd.EntireRow.AutoFilter 1, "*" & Txt & "*"
   ActiveSheet.AutoFilter.Range.Offset(1).EntireRow.Delete
   ActiveSheet.AutoFilterMode = False
End Sub
 

Panoos64

Well-known Member
Joined
Mar 1, 2014
Messages
786
Thank u alan, it works perfect. Thank you for time too. Hv a great day!
 

Panoos64

Well-known Member
Joined
Mar 1, 2014
Messages
786
Hi Fluff, your code works but it delete only the blank row between the two texts. Just i wrote for feedback and no worries for that. Thanks a lot once again for your support. Hv a great day!
 

Forum statistics

Threads
1,077,849
Messages
5,336,736
Members
399,100
Latest member
darcob

Some videos you may like

This Week's Hot Topics

Top