Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 311
  • Last Modified:

Excel Delete Row Based on Text Match

All,

I have a prodedure that imports a text file and performs a heap of manual "clean-up" tasks for me. It was developed by a fellow member of IE but today it has bugged for the first time due to a source data issue that I cannot fix. Thanks to a customer!!!

Can someone please help me insert a method that looks for any instance of " - " inside a date column (26 or 27), then if found, delete the entire row and move on to the next step of code?

I have enclosed the current code to help with solving this issue.

Thanks
CF
ProgressStatus.ProgressBar1.Value = 60
    DoEvents
    
    Sheets("ExportData").Activate
    
    '~~> Perform final clean up
    
    'Check for any instances of " - " in columns 26 or 27
    'if found, delete the entire row.
    
    Set xCell = Columns(26).Find(What:=" - ", LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    
    If Not xCell Is Nothing Then
    delRange.EntireRow.Delete
    
    
    
    'Next Step
    
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
 
    For i = lastRow To 1 Step -1
        If UCase(Trim(Range("N" & i))) = ("FREE INTO STORE") _
        Or UCase(Trim(Range("O" & i))) = ("F.I.") _
        Or DateDiff("D", Range("AA" & i), Date) >= 365 _
        Or Len(Trim(Range("AF" & i))) = 0 _
        Or Len(Trim(Range("AI" & i))) = 0 Then 'column AI = order quantity
            If delRange Is Nothing Then
                Set delRange = Range("N" & i)
            Else
                Set delRange = Union(delRange, Range("N" & i))
            End If
        End If
    Next
    
    delRange.EntireRow.Delete

    ProgressStatus.ProgressBar1.Value = 70
    DoEvents

Open in new window

0
creativefusion
Asked:
creativefusion
  • 4
  • 3
  • 2
2 Solutions
 
Dave BrettCommented:
Do you have a sample file?

And what is the bug/error?

Cheers
Dave
0
 
SiddharthRoutCommented:
Assuming the Date is in Col AA, try this

    For i = LastRow To 1 Step -1
        If UCase(Trim(Range("N" & i))) = ("FREE INTO STORE") _
        Or UCase(Trim(Range("O" & i))) = ("F.I.") _
        Or InStr(1, Range("AA" & i), "-") _
        Or DateDiff("D", Range("AA" & i), Date) >= 365 _
        Or Len(Trim(Range("AF" & i))) = 0 _
        Or Len(Trim(Range("AI" & i))) = 0 Then 'column AI = order quantity
            If delRange Is Nothing Then
                Set delRange = Range("N" & i)
            Else
                Set delRange = Union(delRange, Range("N" & i))
            End If
        End If
    Next

Open in new window


Sid
0
 
creativefusionAuthor Commented:
Hi Dave,

I enclosed a sample file for you to review. The code is inside the modules and is unlocked. If you are the correct Dave, then you will know it well!!

I have highlighted the fields that are causing the error in yellow. You can see the issue very clearly.

You will notice I have made an attempt to start the process but did not have a clue whether I should insert this procedure within the first loop or not!!

CF
EETest.xls
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
creativefusionAuthor Commented:
Sorry, it bugs on line 5.

CF
0
 
SiddharthRoutCommented:
Try this

    For i = LastRow To 1 Step -1
        If InStr(1, Range("AA" & i), "-") Then
            If delRange Is Nothing Then
                Set delRange = Range("N" & i)
            Else
                Set delRange = Union(delRange, Range("N" & i))
            End If
        Else
            If UCase(Trim(Range("N" & i))) = ("FREE INTO STORE") _
            Or UCase(Trim(Range("O" & i))) = ("F.I.") _
            Or DateDiff("D", Range("AA" & i), Date) >= 365 _
            Or Len(Trim(Range("AF" & i))) = 0 _
            Or Len(Trim(Range("AI" & i))) = 0 Then 'column AI = order quantity
                If delRange Is Nothing Then
                    Set delRange = Range("N" & i)
                Else
                    Set delRange = Union(delRange, Range("N" & i))
                End If
            End If
        End If
    Next

Open in new window


Sid
0
 
SiddharthRoutCommented:
In the meantime I am checking your file.

Sid
0
 
Dave BrettCommented:
The sample file seems incomplete

ie
Public Sub doManualLabor()
has a missing End If

??

Cheers

The other Dave
0
 
SiddharthRoutCommented:
Ok, I have made the necessary changes. Replace your doManualLabor() code with this and now try

Public Sub doManualLabor()
    Dim cRow As Long, fRow As Long
    Dim checkRecord As String, importfile As String, ImportData As String
    Dim ExportData As String, emailUser As String, subjectLine As String
    Dim emailWhenDone As Boolean, ExitLoop As Boolean
    Dim delRange As Range, aCell As Range, bCell As Range
    Dim i As Long, lastRow As Long
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    ProgressStatus.Show vbModeless
    
    Sheets("ExportData").Delete
        
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "ExportData"
        
    Sheets("ImportData").Activate
    Range("1:1").Copy
     
    ProgressStatus.ProgressBar1.Value = 5
    DoEvents
    
    Sheets("ExportData").Range("A1").PasteSpecial xlPasteAll
    For cRow = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row 'copy and paste out the original set, clearing AJ-AM
        Rows(cRow).Copy
        Sheets("ExportData").Range("A" & cRow).PasteSpecial xlPasteAll
        Range(Range("ExportData!AJ" & cRow), Range("ExportData!BC" & cRow)).ClearContents
    Next cRow
       
    ProgressStatus.ProgressBar1.Value = 10
    DoEvents
    
    fRow = cRow
    For cRow = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row 'Now find blocks in the file to copy down
        checkRecord = Range("AJ" & cRow).Value & Range("AK" & cRow).Value & Range("AL" & cRow) & Range("AM" & cRow).Value
        If Trim(checkRecord) <> "" Then 'getting to work cutting and pasting the records found to the right of the file
            Rows(cRow).Copy
            Range("ExportData!A" & fRow).PasteSpecial xlPasteAll
            Range(Range("ExportData!AJ" & fRow), Range("ExportData!BC" & fRow)).ClearContents
            Range(Range("AJ" & cRow), Range("AM" & cRow)).Copy
            Range("ExportData!AF" & fRow).PasteSpecial xlPasteAll
            fRow = fRow + 1
        End If
    Next cRow
        
    ProgressStatus.ProgressBar1.Value = 20
    DoEvents
        
    For cRow = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row 'Now find blocks to copy down
        checkRecord = Range("AN" & cRow).Value & Range("AO" & cRow).Value & Range("AP" & cRow) & Range("AQ" & cRow).Value
        If Trim(checkRecord) <> "" Then 'getting to work cutting and pasting all the records found to the right of the file
            Rows(cRow).Copy
            Range("ExportData!A" & fRow).PasteSpecial xlPasteAll
            Range(Range("ExportData!AJ" & fRow), Range("ExportData!BC" & fRow)).ClearContents
            Range(Range("AN" & cRow), Range("AQ" & cRow)).Copy
            Range("ExportData!AF" & fRow).PasteSpecial xlPasteAll
            fRow = fRow + 1
        End If
    Next cRow
        
    ProgressStatus.ProgressBar1.Value = 30
    DoEvents
        
    For cRow = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row 'Now find blocks to copy down
        checkRecord = Range("AR" & cRow).Value & Range("AS" & cRow).Value & Range("AT" & cRow) & Range("AU" & cRow).Value
        If Trim(checkRecord) <> "" Then 'getting to work cutting and pasting all the records found to the right of the file
            Rows(cRow).Copy
            Range("ExportData!A" & fRow).PasteSpecial xlPasteAll
            Range(Range("ExportData!AJ" & fRow), Range("ExportData!BC" & fRow)).ClearContents
            Range(Range("AR" & cRow), Range("AU" & cRow)).Copy
            Range("ExportData!AF" & fRow).PasteSpecial xlPasteAll
            fRow = fRow + 1
        End If
    Next cRow
        
    ProgressStatus.ProgressBar1.Value = 40
    DoEvents
        
    For cRow = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row 'Now find blocks to copy down
        checkRecord = Range("AV" & cRow).Value & Range("AW" & cRow).Value & Range("AX" & cRow) & Range("AY" & cRow).Value
        If Trim(checkRecord) <> "" Then 'get to work cutting and pasting
            Rows(cRow).Copy
            Range("ExportData!A" & fRow).PasteSpecial xlPasteAll
            Range(Range("ExportData!AJ" & fRow), Range("ExportData!BC" & fRow)).ClearContents
            Range(Range("AV" & cRow), Range("AY" & cRow)).Copy
            Range("ExportData!AF" & fRow).PasteSpecial xlPasteAll
            fRow = fRow + 1
        End If
    Next cRow
        
    ProgressStatus.ProgressBar1.Value = 50
    DoEvents
        
    For cRow = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row 'Now find blocks to copy down
        checkRecord = Range("AZ" & cRow).Value & Range("BA" & cRow).Value & Range("BB" & cRow) & Range("BC" & cRow).Value
        If Trim(checkRecord) <> "" Then 'get to work cutting and pasting
            Rows(cRow).Copy
            Range("ExportData!A" & fRow).PasteSpecial xlPasteAll
            Range(Range("ExportData!AJ" & fRow), Range("ExportData!BC" & fRow)).ClearContents
            Range(Range("AZ" & cRow), Range("BC" & cRow)).Copy
            Range("ExportData!AF" & fRow).PasteSpecial xlPasteAll
            fRow = fRow + 1
        End If
    Next cRow
    
    ProgressStatus.ProgressBar1.Value = 60
    DoEvents
    
    Sheets("ExportData").Activate
    
    '~~> Perform final clean up
    
    'Check for any instances of " - " in columns 26 or 27
    'if found, delete the entire row.
    
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
 
    For i = lastRow To 1 Step -1
        If InStr(1, Range("Z" & i), "-") Or InStr(1, Range("AA" & i), "-") Then
            If delRange Is Nothing Then
                Set delRange = Range("N" & i)
            Else
                Set delRange = Union(delRange, Range("N" & i))
            End If
        Else
            If UCase(Trim(Range("N" & i))) = ("FREE INTO STORE") _
            Or UCase(Trim(Range("O" & i))) = ("F.I.") _
            Or DateDiff("D", Range("AA" & i), Date) >= 365 _
            Or Len(Trim(Range("AF" & i))) = 0 _
            Or Len(Trim(Range("AI" & i))) = 0 Then 'column AI = order quantity
                If delRange Is Nothing Then
                    Set delRange = Range("N" & i)
                Else
                    Set delRange = Union(delRange, Range("N" & i))
                End If
            End If
        End If
    Next
    
    delRange.EntireRow.Delete

    ProgressStatus.ProgressBar1.Value = 70
    DoEvents
    
    Set aCell = Columns(32).Find(What:="290", LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        Set bCell = aCell
        aCell.Value = "BRIS"
        Do While ExitLoop = False
            Set aCell = Columns(32).FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                aCell.Value = "BRIS"
            Else
                ExitLoop = True
            End If
        Loop
    End If
    
    ProgressStatus.ProgressBar1.Value = 80
    DoEvents
    
    ExitLoop = False
    
    Set aCell = Columns(32).Find(What:="590", LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        Set bCell = aCell
        aCell.Value = "ADEL"
        Do While ExitLoop = False
            Set aCell = Columns(32).FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                aCell.Value = "ADEL"
            Else
                ExitLoop = True
            End If
        Loop
    End If
    
    ProgressStatus.ProgressBar1.Value = 90
    DoEvents
    
    '~~> Inserting the key for vlookup
    
    lastRow = Range("B" & Rows.Count).End(xlUp).Row
    
    Range("BJ1").Formula = "=TRIM(B1)&E1&TRIM(AF1)"
    Range("BJ1").AutoFill Destination:=Range("BJ1:BJ" & lastRow), Type:=xlFillDefault
    
    'copying the header over to the completed export data sheet
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    
    Sheets("ImportData").Select
    Range("A1:E1").Select
    Selection.Copy
    Sheets("ExportData").Select
    Range("A1:E1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    
    Application.CutCopyMode = False
    
    Application.Calculation = xlCalculationAutomatic

    ActiveWorkbook.Save
    
    ProgressStatus.ProgressBar1.Value = 100
    DoEvents
    
    Unload ProgressStatus
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

Open in new window


Sid
0
 
creativefusionAuthor Commented:
Thanks guys. Wonderful help once again.
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 4
  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now