VBA Code issue - Please Help!

[AlexCS]

Hi everyone,

Can anyone tell what is wrong with the following If in For? The macro would not resume the Next bit - the if works just fine but only the first row is investigated then the execution terminates without ever getting to the second row.

'First complex If - see Decision Tree tab

Sheets("Shipment Table").Select
ActiveSheet.Range(Range("A1"), Cells.SpecialCells(xlCellTypeLastCell)).AutoFilter Field:=4, Criteria1:="100.0000%"
Sheets("Shipment Table").Select
ActiveSheet.Cells(1, 1).CurrentRegion.Select
nrLines = Selection.Rows.Count

For s = 2 To nrLines

If ActiveSheet.Cells(s, 2).Value = ActiveSheet.Cells(s, 3).Value Then

If ActiveSheet.Cells(s, 6).Value = "" Then

If ActiveSheet.Cells(s, 7).Value = "" Then
ActiveSheet.Rows(s).Select
Selection.EntireRow.Delete


Else
ActiveSheet.Rows(s).EntireRow.Select
Selection.Copy
Sheets("Unload").Activate
If ActiveSheet.Cells(2, 1).Value <> 0 Then
ActiveSheet.Cells(1, 1).CurrentRegion.Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Else
Sheets("Unload").Cells(1, 1).Select
ActiveCell.Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End If

Else
ActiveSheet.Rows(s).EntireRow.Select
Selection.Copy
Sheets("Investigate").Activate
If ActiveSheet.Cells(2, 1).Value <> 0 Then
ActiveSheet.Cells(1, 1).CurrentRegion.Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Else
Sheets("Investigate").Cells(1, 1).Select
ActiveCell.Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


End If


Else

If ActiveSheet.Cells(s, 3).Value = 0 Then
ActiveSheet.Rows(s).EntireRow.Select
Selection.Copy
Sheets("Import").Activate
If ActiveSheet.Cells(2, 1).Value <> 0 Then
ActiveSheet.Cells(1, 1).CurrentRegion.Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Else
Sheets("Import").Cells(1, 1).Select
ActiveCell.Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False



Else
ActiveSheet.Rows(s).EntireRow.Select
Selection.Copy
Sheets("Investigate").Activate
If ActiveSheet.Cells(2, 1).Value <> 0 Then
ActiveSheet.Cells(1, 1).CurrentRegion.Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Else
Sheets("Investigate").Cells(1, 1).Select
ActiveCell.Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


End If

End If

Next s

Sheets("Shipment Table").Select
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False


Please help! I have been looking at this for a while and just cannot figure it out...

Thanks a lot,

Alex

 

[RoryA]

In your code, some of the branches activate other sheets, but you never reactivate the sheet you were on to start with, so the next loop will be looking at the wrong activesheet.

 

[AlexCS]

Thank you so much! Sometimes the most logical of things escape us..

Do you think I should activate the lookup tab just once in the main if or should I activate it in each if that suggests a change of tab?

Alex

 

[RoryA]

You shouldn't need to activate anything at all here. I think this does the same thing as yours:

'First complex If - see Decision Tree tab
   Dim rngCell           As Range
   Dim s                 As Long

   With Sheets("Shipment Table")

      .Range(.Range("A1"), .Cells.SpecialCells(xlCellTypeLastCell)).AutoFilter Field:=4, Criteria1:="100.0000%"

      ' only loop through visible cells
      For Each rngCell In .Cells(1, 1).CurrentRegion.Columns(4).SpecialCells(xlCellTypeVisible)

         s = rngCell.Row

         If .Cells(s, 2).Value = .Cells(s, 3).Value Then

            If .Cells(s, 6).Value = "" Then

               If .Cells(s, 7).Value = "" Then
                  .Rows(s).Delete
               Else
                  .Rows(s).Copy
                  ' paste to next unused row on Unload sheet
                  Sheets("Unload").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, _
                                                               Operation:=xlNone, SkipBlanks:=False, Transpose:=False
               End If

            Else

               .Rows(s).Copy
               ' paste to next unused row on Investigate sheet
               Sheets("Investigate").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, _
                                                               Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End If   ' .Cells(s, 6).Value = ""

         Else

            If .Cells(s, 3).Value = 0 Then
               Rows(s).Copy
               ' paste to next unused row on Import sheet
               Sheets("Import").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, _
                                                               Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Else
               .Rows(s).Copy
               ' paste to next unused row on Investigate sheet
               Sheets("Investigate").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, _
                                                               Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End If   ' .Cells(s, 3).Value = 0

         End If   ' .Cells(s, 2).Value = .Cells(s, 3).Value

      Next rngCell

      .AutoFilterMode = False
   End With

but please test on a copy of your file!

 

[AlexCS]

You are amazing Rory..I am really grateful you took the time to look at my lengthy trials.

Your code does work, though the results are slightly different. I am going to build on it, I am sure you saved me at least one day of work

Thanks again!

Alex