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
Solved

Excel Delete Row Based on Text Match

Posted on 2011-02-28
9
286 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
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 

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 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

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

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.

Question has a verified solution.

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

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

856 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