Solved

Excel Delete Row Based on Text Match

Posted on 2011-02-28
9
262 Views
Last Modified: 2012-08-13
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
Comment
Question by:creativefusion
  • 4
  • 3
  • 2
9 Comments
 
LVL 50

Assisted Solution

by:Dave Brett
Dave Brett earned 50 total points
ID: 35004193
Do you have a sample file?

And what is the bug/error?

Cheers
Dave
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35004240
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
 

Author Comment

by:creativefusion
ID: 35004255
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
 

Author Comment

by:creativefusion
ID: 35004257
Sorry, it bugs on line 5.

CF
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35004263
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35004266
In the meantime I am checking your file.

Sid
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 35004270
The sample file seems incomplete

ie
Public Sub doManualLabor()
has a missing End If

??

Cheers

The other Dave
0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 450 total points
ID: 35004442
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
 

Author Closing Comment

by:creativefusion
ID: 35011764
Thanks guys. Wonderful help once again.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

A2 = A1 That kind of cell reference is relative.  If you copy it from A2 to B2, then B2 will get this: B2 = B1 That's all fine and good, but if you then insert a new row above row 2, you'll find: A3 = A1 B3 = B1 This is intentional. …
Dealing with unintended Excel Active-X resizing quirks (VBA code simulates "self correction") David Miller (dlmille) Intro Not everyone is a fan of Active-X controls in spreadsheets (as opposed to the UserForm approach, the older Form controls …
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

706 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now