Skip to content

SHRIMP: Sub SQUIDClean

sbodorkos edited this page Jun 13, 2018 · 1 revision

I have named this subroutine "SQUIDClean". Ludwig named it "Clean" in his VBA code, but that is confusing, because there exists a Microsoft VBA function of the same name, and it took me a while to work out there was a difference!

Sub Clean(DatRange As Range, CleanedDat As Range, NumCleanRows%, _ Optional ZeroesOK As Boolean = False, Optional BlankOk As Boolean = False, _ Optional AllColsOK As Boolean = False, Optional BothNegPos As Boolean = True, _ Optional StrikeThruOK As Boolean = False, Optional AllComers As Boolean = False, _ Optional AddStrikeThru As Boolean = False) ' Returns Cleandat as array cleaned of all noncomplying rows.

Dim First As Boolean, OkCel As Boolean Dim Nareas%, Ncols%, OKcol%, Col%, AreaIndx%, TempNum%, CleanedRowCt% Dim Rw&, RowCt&, v# Dim Cel As Range, Area As Range, Crow As Range

First = TRUE  

With DatRange  
  
  If AllColsOK = TRUE
    Ncols = DatRange.Columns.Count
  Else
    Ncols = 1
  End If  
  
  CleanedRowCt = 0  
  
  Nareas = DatRange.Areas.Count

  For AreaIndx = 1 To Nareas  
  
    TempNum = 1 + CleanedRowCt  
    
    Set Area = DatRange.Areas[AreaIndx]  
    
    With Area
      RowCt = Area.Rows.Count
  
      For Rw = 1 To RowCt
        TempNum = 1 + CleanedRowCt  
        OKcol = 0
    
        For Col = 1 To Ncols
          Set Cel = Area.Item[Rw, Col]
          OkCel = FALSE
      
          If (BlankOk = TRUE) OR (Cel.Formula <> "") OR (AllComers = TRUE) --Area1
      
            If (IsNumeric(Cel) = TRUE) Or (AllComers = TRUE) --Area2
              
              With Cel
                
                v = Cel.Value
            
                If (ZeroesOK = TRUE) OR (v <> 0) OR (AllComers = TRUE) --Cel1
                
                  If (BothNegPos = TRUE) OR (v > 0) OR (AllComers = TRUE) --Cel2
              
                    If (StrikeThruOK = TRUE) OR (Cel.Font.Strikethrough = FALSE) Or (AllComers = TRUE) --Cel3
                    
                      OKcol = 1 + OKcol
                      OkCel = TRUE
                      
                    End If --Cel3
                
                  End If --Cel2
                  
                End If --Cel1
                
              End With --Cel
              
            End If --Area2
        
          End If --Area1
      
          If (OkCel = FALSE) AND (AddStrikeThru = TRUE)
            Cel.Font.Strikethrough = TRUE
          End If
      
          If OKcol < Col 
            Exit For
          End If
        Next Col
    
        If OKcol = Ncols 
          
          CleanedRowCt = 1 + CleanedRowCt
          Set Crow = Range( Area.Item[Rw, 1], Area.Item[Rw, Ncols] )
      
          If First = TRUE  
            
            Set CleanedDat = Crow
            First = FALSE
            
          Else
            
            Set CleanedDat = Union( CleanedDat, Crow )
            
          End If --First = TRUE
      
        End If --OKcol = Ncols
    
      Next Rw
  
    End With --Area
  Next AreaIndx

End With --DatRange

NumCleanRows = CleanedRowCt

End Sub
Clone this wiki locally