Home > Mobile >  Vba for loop bugging easily when you store data into an array
Vba for loop bugging easily when you store data into an array

Time:06-01

I have an Vba for loop, using autofilter and then storing data into an array. The section marked below usually bugs after a few loops, saying "cell not found", and then it works again after rerunning it a few times or inserting messageboxes. Any suggestions so that it could be run from start to finish without bugging?

For Each C In rng1.SpecialCells(xlCellTypeVisible).Rows
  With rng2
  .AutoFilter field:=9, Criteria1:=C.Columns(4)
  .AutoFilter field:=12, Criteria1:=C.Columns(5)
  
  DirArray(0) = rng2.SpecialCells(xlCellTypeVisible).Rows(1).Columns(23).Value   <------------------- ERROR STARTS HERE //
DirArray(1) = rng2.SpecialCells(xlCellTypeVisible).Rows(1).Columns(24).Value

Set rng3 = rng2.SpecialCells(xlCellTypeVisible).Rows(1).Columns(1)
  Set rng4 = rng2.SpecialCells(xlCellTypeVisible).Rows(1).Columns(1).End(xlDown).End(xlToLeft)
  
  
  
  
      For Each i In x.Sheets("Sheet1").Range(rng3, rng4).Rows
       If i.Columns(24) - i.Columns(23) > DirArray(1) - DirArray(0) Then
        DirArray(0) = i.Columns(23).Value
        DirArray(1) = i.Columns(24).Value
        DirArray(2) = i.Columns(39).Value
        DirArray(3) = i.Columns(40).Value
        DirArray(4) = i.Columns(20).Value
       End If
    
     Next i
    
   C.Columns(15).Value = DirArray(2
End With 
Next C

CodePudding user response:

I'm assuming it's failing on the loops when the AutoFilter applied results in no cells in rng2 being visible. SpecialCells(xlCellTypeVisible) throws an error when there are no cells, so you can't test it directly.

You have add a test after setting the autofilter that "tries" to use the range, then wrap the rest of the loop in an if statement if the test passed. E.g.:

For Each C In rng1.SpecialCells(xlCellTypeVisible).Rows
  With rng2
    .AutoFilter field:=9, Criteria1:=C.Columns(4)
    .AutoFilter field:=12, Criteria1:=C.Columns(5)
  
    Set lngTest = 0
    On Error Resume Next
    Set lngTest = rng2.SpecialCells(xlCellTypeVisible).Count
    On Error Goto 0

    If lngTest > 0 Then

        DirArray(0) = rng2.SpecialCells(xlCellTypeVisible).Rows(1).Columns(23).Value   
        DirArray(1) = rng2.SpecialCells(xlCellTypeVisible).Rows(1).Columns(24).Value
    
        Set rng3 = rng2.SpecialCells(xlCellTypeVisible).Rows(1).Columns(1)
        Set rng4 = rng2.SpecialCells(xlCellTypeVisible).Rows(1).Columns(1).End(xlDown).End(xlToLeft)         
      
        For Each i In x.Sheets("Sheet1").Range(rng3, rng4).Rows
             If i.Columns(24) - i.Columns(23) > DirArray(1) - DirArray(0) Then
                 DirArray(0) = i.Columns(23).Value
                 DirArray(1) = i.Columns(24).Value
                 DirArray(2) = i.Columns(39).Value
                 DirArray(3) = i.Columns(40).Value
                 DirArray(4) = i.Columns(20).Value
              End If     
          Next i
        
          C.Columns(15).Value = DirArray(2

    End If

  End With 

Next C
  • Related