Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Excel Delete Row Based on Text Match

Posted on 2011-02-28
9
Medium Priority
?
308 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 3
  • 2
9 Comments
 
LVL 50

Assisted Solution

by:Dave Brett
Dave Brett earned 200 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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 

Author Comment

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

CF
0
 
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 1800 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

Independent Software Vendors: 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!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

722 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