Logic Error in Nested If Then Statements

[goss]

Hi all,

Using Excel 2010.

I extracted data from .pdf to Excel using Able2Extract
Now I need to scrub the output a bit.

I see commonalities in the data for the start and stop of each set of data that I can key in on.

Once I find the start and stop points for each set of data I would like to fill all rows in-between the points and then discard anything that remains outside of these boundaries.

I have something wrong in my logic, way too many rows are deleted.
Does anyone else see the problem in my logic?

Option Explicit

Sub GetLineSets()
    'Purpose: Identify relevant line sets, delete all other rows
    Dim wbBook As Workbook
    Dim wsData As Worksheet
    Dim strFormula As String
    Dim lngRows As Long
    Dim C As Range
    Dim blnFlag As Boolean
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With
    
    Set wbBook = ThisWorkbook
    Set wsData = wbBook.Worksheets("Data")
    blnFlag = False

    lngRows = wsData.Range("A65536").End(xlUp).Row
    strFormula = "=IF(AND(ISERROR(FIND(""INVOICE NUMBER"",F1)),ISERROR(FIND(""INVOICE TOTAL"",C1))),0,""INVOICE"")"
     
    With wsData
        .Range("A1").EntireColumn.Insert
        .Range("A1:A" & lngRows).Formula = strFormula
        
        For Each C In .Range("A1:A" & lngRows)
            C.Value = C.Value
        Next C
        
        Do While lngRows >= 1
            If blnFlag = False Then
                If .Cells(lngRows, 1).Value = 0 Then
                    .Cells(lngRows, 1).EntireRow.Delete
                End If
            Else
                If .Cells(lngRows, 1).Value = "Department" Then
                    blnFlag = True
                Else
                    If .Cells(lngRows, 1).Value = 0 Then
                        .Cells(lngRows, 1).Value = "Department"
                    Else
                        .Cells(lngRows, 1).EntireRow.Delete
                    End If
                End If
            End If
            lngRows = lngRows - 1 'Decrement counter
        Loop
    End With
    
    'Tidy Up
        Set wbBook = Nothing
        Set wsData = Nothing
        Set C = Nothing

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .Calculation = xlCalculationAutomatic
    End With
     
End Sub

 

[njimack]

The accepted method when deleting rows is to work backwards. Something like this:

       [COLOR=Red] [B]For i = lngRows To 1 Step -1[/B][/COLOR]
            If blnFlag = False Then
                If .Cells(lngRows, 1).Value = 0 Then
                    .Cells(lngRows, 1).EntireRow.Delete
                End If
            Else
                If .Cells(lngRows, 1).Value = "Department" Then
                    blnFlag = True
                Else
                    If .Cells(lngRows, 1).Value = 0 Then
                        .Cells(lngRows, 1).Value = "Department"
                    Else
                        .Cells(lngRows, 1).EntireRow.Delete
                    End If
                End If
            End If
            lngRows = lngRows - 1 'Decrement counter
        [COLOR=Red][B]Next i[/B][/COLOR]

 

[Norie]

Is the worksheet formula working as expected?

Have you considered not using it?

You are already looping through the rows twice, why not loop through them once and check if the data should be deleted.

Not sure what you are checking for but there are one or two VBA functions you might be able to use.

In fact in the 2nd loop you seem to be doing a check in the code, why not extend that?

 

[goss]

Thanks Neil/Norie,

I took another look at the data and thought of a slightly different process using a couple of helper columns. Not as elegant..but easier for me to understand.

thx
w

Final:

Option Explicit

Sub GetLineSets()
    'Purpose: Identify relevant line sets to invoices, delete all other rows
    Dim wbBook As Workbook
    Dim wsData As Worksheet
    Dim C As Range
    Dim myRange As Range
    Dim strFormula As String
    Dim strFormula2 As String
    Dim strFormula3 As String
    Dim myValue As String
    Dim lngRows As Long
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With
    
    Set wbBook = ThisWorkbook
    Set wsData = wbBook.Worksheets("Data")
    myValue = 0

    lngRows = wsData.Range("B65536").End(xlUp).Row
    strFormula = "=IF(ISERROR(FIND(""Department Number"",H1)),0,""Department"")"
    strFormula2 = "=IF(ISERROR(FIND(""Department Total"",E1)),0,""Department Total"")"
    strFormula3 = "=IF(ISTEXT(A1),A1,IF(ISTEXT(B1),B1,0))"
     
    With wsData
        .Range("A1:C1").EntireColumn.Insert
        .Range("A1:A" & lngRows).Formula = strFormula
        .Range("B1:B" & lngRows).Formula = strFormula2
        .Range("C1:C" & lngRows).Formula = strFormula3
        
        For Each C In .Range("A1:C" & lngRows)
            C.Value = C.Value
        Next C

        .Range("A1:B1").EntireColumn.Delete

        Set myRange = .Range("A1:A" & lngRows)

        For Each C In myRange
            If C.Value = "Department Total" Then
                C.Value = "Department Total"
                myValue = 0
            Else
                If C.Value = 0 Then
                    C.Value = myValue
                Else
                    myValue = C.Value
                End If
            End If
        Next C
        
        'Delete non-relevant rows
            Do While lngRows >= 1
                If .Cells(lngRows, 1).Value = 0 Then
                    .Cells(lngRows, 1).EntireRow.Delete
                End If
                lngRows = lngRows - 1
            Loop
            
    End With
    
    'Tidy Up
        Set wbBook = Nothing
        Set wsData = Nothing
        Set C = Nothing
        Set myRange = Nothing

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .Calculation = xlCalculationAutomatic
    End With
     
End Sub

 

[Norie]

You could probably speed the code up a bit by either not changing the formulas to values or doing it in one go.

.Range("A1:C" & lngRows).Value = .Range("A1:C" & lngRows).Value