Announcement

Collapse
No announcement yet.

Excel AutoFilter Criteria

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Excel AutoFilter Criteria

    I am unable to get Excel's AutoFilter to work. I can set the AutoFilters on, but I cannot set the filter criteria to show "(Blanks)".

    I have tried many different ways to set the criteria, and nothing is working yet.

    This is the line in the code that fails:
    Code:
    OBJECT SET oSheet.Range(vSelect).AutoFilter = vWork1           '<<<<<<<<<<<<<<< 'Not Working
    I put the the Excel Macro I recorded into the comments just above the failing code.

    Any ideas, hints, directions greatly appreciated!

    Here's the source, includes, and a test xls file:
    Jimbo.zip

    Here's the source for the test app:
    Code:
    #COMPILE EXE "AAAtest.exe
    #COMPILER PBWIN "10.4"
    #DIM ALL
    #INCLUDE ONCE "INCLUDES\WIN32api.INC" 'José Roca's Includes
    #INCLUDE ONCE "INCLUDES\Excel.9.inc"
    #INCLUDE ONCE "INCLUDES\Excel_OG_Constants.inc
    #INCLUDE ONCE "INCLUDES\WMI.INC"
    '--------------------------------------------------------------------------------
    '-
    '--------------------------------------------------------------------------------
    FUNCTION PBMAIN
    LOCAL i, x, iLastCol, iLastRow             AS LONG
    LOCAL vRow,vCol,vWork1,vWork2,vTrue,vFalse AS VARIANT
    LOCAL vCell1, vCell2, vSelect              AS VARIANT
    LOCAL vFileIn,vFileOut,vFormat,oVnt,vAlert AS VARIANT
    LOCAL oApp                                 AS Excel_Application
    LOCAL oBook                                AS Excel_Workbook
    LOCAL oSheet                               AS Excel_WorkSheet
    
        vTrue   = -1
        vFalse  = 0
        vAlert   = 0                                         ' 1=turn on alerts, 0=turn off
        vFileIn = CURDIR$ & "\Jimbo.xls"
    
        ' Open an instance of EXCEL
        oApp = GETCOM $PROGID_Excel_Application              ' Get the running Excel handle
        IF ISFALSE ISOBJECT(oApp) THEN                       ' If Excel is not running,
            oApp = NEWCOM $PROGID_Excel_Application          '   and start a new instance of Excel
            IF ISFALSE ISOBJECT(oApp) OR ERR THEN            '   Could EXCEL be opened? If not, terminate this app
                MSGBOX "Excel Application could not be opened." _
                & $LF & "Verify that Excel and VBA are installed.",%MB_ICONERROR,EXE.NAME$
                FUNCTION = -1
                GOTO Terminate
            END IF
        END IF
        '----------------------------------------------------------------
    
        OBJECT LET oApp.Visible = vTrue                                 ' TESTING, show work book
        OBJECT LET oApp.DisplayAlerts = vAlert                          ' Suppress alerts (like "Overwrite existing file?") or not.
    
        ' Open a workbook
        OBJECT CALL oApp.WorkBooks.open(vFileIn) TO oBook                        ' If problem opening input,
        IF OBJRESULT OR ERR THEN                                                 '  report and exit.
            MSGBOX "Excel could not open the workbook." _
            & $LF & "Verify that VBA is installed.",%MB_ICONERROR,EXE.NAME$
            FUNCTION = -1
            GOTO Terminate
        END IF
    
        OBJECT GET oBook.Activesheet TO vWork1                                   ' Save worksheet object
        SET oSheet = vWork1
    
        '--------------------------------------------------------------------------------
        '-
        '--------------------------------------------------------------------------------
    
        ' Ensure that any frozen panes are unfrozen.
        OBJECT LET oApp.ActiveWindow.FreezePanes = vFalse                        ' VBA: ActiveWindow.FreezePanes = False
    
        ' Select the last occupied cell
        vWork1 = %xlLastCell                                                     ' VBA: ActiveCell.SpecialCells(xlLastCell).Select2
        OBJECT CALL oApp.ActiveCell.SpecialCells(vWork1).Select                  '      "
    
        ' Save the last occupied column number
        OBJECT GET oApp.ActiveCell.Column TO vWork2                              ' VBA: iLastCol = ActiveCell.Column
        iLastCol = VARIANT#(vWork2)                                              '      "
        OBJECT GET oApp.ActiveCell.Row TO vWork1
        iLastRow = VARIANT#(vWork1)
    
        ' Save this to a range for use later.
        vSelect  = "$A$1:$" & AlphaCol(iLastCol) & "$" & FORMAT$(iLastRow)       ' Save used columns for later
    
        ' Select all cells in workbook
        OBJECT CALL oSheet.Cells.Select                                          ' VBA: Cells.Select
    
        ' Ensure any filters turned off
        OBJECT GET oSheet.AutoFilterMode TO vWork1                               ' VBA: If ActiveSheet.AutoFilterMode Then
        i = VARIANT#(vWork1)                                                     '      "
        IF i THEN                                                                '      "
            OBJECT CALL oSheet.range(vSelect).Autofilter                         '      VBA: Selection.AutoFilter '  When on, turn off.
        END IF
    
        ' Turn on filters for occupied rows.
        OBJECT CALL oSheet.Range(vSelect).Autofilter                             ' VBA: Selection.AutoFilter '  Turn on
    
    
    
        '-------------------------------------------------------------------------------------------------------------------------------------------------
        ''' This is simple VBA Macro from Excel to set filter criteria.
        ''' It was made using the Record Macro feature.
        ''
        '' Sub AutoFilterBlanks()
        ''     Cells.Select                                                         ' Select all cells
        ''     Selection.AutoFilter                                                ' turn on AutoFilter
        ''     ActiveSheet.Range("$A$1:$C$8").AutoFilter Field:=3, Criteria1:="="   ' Set each desired column to show only blanks.
        ''     ActiveSheet.Range("$A$1:$C$8").AutoFilter Field:=2, Criteria1:="="   '  "
        ''     ActiveSheet.Range("$A$1:$C$8").AutoFilter Field:=1, Criteria1:="="   '  "
        '' End Sub
        '-------------------------------------------------------------------------------------------------------------------------------------------------
        ' Set filter for column 1 to show only Blanks.
    
        vWork1 = "FIELD:=1, Criteria1:=""="""
        TRY
            OBJECT SET oSheet.Range(vSelect).AutoFilter = vWork1           '<<<<<<<<<<<<<<< 'Not Working
        CATCH
            MSGBOX "Error" & STR$(ERR) & ": " & WmiGetErrorCodeText(OBJRESULT),%MB_ICONERROR,EXE.NAME$
        END TRY
    
    
    
        '-------------------------------------------------------------------------------------------------------------------------------------------------
        ' Select Col 1 Row 2 cell
        vSelect = "A2"
        OBJECT CALL oSheet.Range(vSelect).Select
        '--------------------------------------------------------------------------------
        '- End of VBA conversion
        '--------------------------------------------------------------------------------
        MSGBOX "Did it work?",%MB_ICONQUESTION,EXE.NAME$
        OBJECT CALL oBook.Save
        OBJECT CALL oBook.Close
    
    Terminate:
        ERRCLEAR
        CoUninitialize()
        SET oApp   = NOTHING
        SET oSheet = NOTHING
        SET oBook  = NOTHING
        MSGBOX "Close Excel App if still open.",%MB_ICONASTERISK,EXE.NAME$
    END FUNCTION
    
    
    '--------------------------------------------------------------------------------
    '- Excel Helper routines
    '--------------------------------------------------------------------------------
    '--------------------------------------------------------------------------------
    '- sCol = AlphaCol(Col[, String-Length])
    '- EG:  sCol = AlphaCol(26)   ' << Result sCol = "Z"
    '-      sCol = AlphaCol(26,3) ' << Result sCol = "  Z"
    '--------------------------------------------------------------------------------
    FUNCTION AlphaCol ALIAS "AlphaCol" (BYVAL iColumn AS LONG, OPTIONAL BYVAL iLen AS LONG) AS STRING
    REGISTER Index AS LONG, Divisor AS LONG, Char AS LONG
    LOCAL sText AS STRING
       IF iLen = 0 THEN iLen = 1
       Index = iColumn - 1
       Divisor = 26&
       WHILE Index >= Divisor
          !mov eax, Index
          !mov edx, 0
          !div Divisor               ;eax = Source \ Divisor,  edx = Source MOD Divisor
    
          !dec eax
          !mov Index, eax
          !mov Char, edx
    
          sText = CHR$( Char + 65) & sText
       WEND
       sText = CHR$(Index + 65) & sText
       IF LEN(sText) < iLen THEN sText = RSET$(sText, iLen USING "0")
       FUNCTION = sText
    END FUNCTION
    '--------------------------------------------------------------------------------
    '- sRange = AlphaRange(Start-Row, Start-Col, End-Row, End-Col)
    '- EG:    sRange = AlphaRange(1,1,1000,28) ' <<< Result sRange = "A1:AB1000"
    '--------------------------------------------------------------------------------
    FUNCTION AlphaRange(iRowS AS LONG,iColS AS LONG,iRowE AS LONG,iColE AS LONG) AS STRING
    REGISTER Index AS LONG, Divisor AS LONG, Char AS LONG
    LOCAL sTextS,sTextE AS STRING
    
       Divisor = 26&
    
       Index = iColS - 1
       WHILE Index >= Divisor
          !mov eax, Index
          !mov edx, 0
          !div Divisor               ;' eax = Source \ Divisor,  edx = Source MOD Divisor
    
          !dec eax
          !mov Index, eax
          !mov Char, edx
    
          sTextS = CHR$( Char + 65) & sTextS
       WEND
       sTextS = CHR$(index + 65) & sTextS & FORMAT$(iRowS)
    
       Index = iColE - 1
       WHILE Index >= Divisor
          !mov eax, Index
          !mov edx, 0
          !div Divisor               ;' eax = Source \ Divisor,  edx = Source MOD Divisor
    
          !dec eax
          !mov Index, eax
          !mov Char, edx
    
          sTextE = CHR$( Char + 65) & sTextE
       WEND
       sTextE = CHR$(index + 65) & sTextE & FORMAT$(iRowE)
       FUNCTION = sTextS & ":" & sTextE
    
    END FUNCTION
    '--------------------------------------------------------------------------------
    '- EG: sCell = AlphaReference(42,24) ' Result  sCell = "X42"
    '--------------------------------------------------------------------------------
    FUNCTION AlphaReference(iRow AS LONG, iCol AS LONG) AS STRING
       'Index = BASE 1 number for the column
    REGISTER Index AS LONG, Divisor AS LONG, Char AS LONG
    LOCAL    sText AS STRING
       Index = iCol - 1
       Divisor = 26&
       WHILE Index >= Divisor
          !mov eax, Index
          !mov edx, 0
          !div Divisor               ;' eax = Source \ Divisor,  edx = Source MOD Divisor
    
          !dec eax
          !mov Index, eax
          !mov Char, edx
    
          sText = CHR$( Char + 65) & sText
       WEND
       FUNCTION = CHR$(index + 65) & sText & FORMAT$(iRow)
    END FUNCTION
    '--------------------------------------------------------------------------------
    '-
    '--------------------------------------------------------------------------------
    ... .... . ... . . ... ... .... . .. ... .... .. ... .... .. .... ..

    n6jah @ yahoo.com

  • #2
    I cannot help you with Excel because I have not it installed, but it surprises me your use of WmiGetErrorCodeText. What has to do WMI with Excel?
    Forum: http://www.jose.it-berater.org/smfforum/index.php

    Comment


    • #3
      Jim,

      This syntax works for me (Excel 2010):

      Code:
          DIM PB_Field  AS VARIANT
          DIM Criteria1 AS VARIANT
      
          PB_Field ="1"
          Criteria1=""
          TRY
              OBJECT CALL oSheet.Range(vSelect).AutoFilter(PB_Field,Criteria1)
      I found it in Excel9.inc:

      Code:
        MEMBER CALL AutoFilter <793> (OPT IN PB_Field AS VARIANT<0>, OPT IN Criteria1 AS VARIANT<1>, OPT IN Operator AS LONG<2>, _
          OPT IN Criteria2 AS VARIANT<3>, OPT IN VisibleDropDown AS VARIANT<4>) AS VARIANT
      Julien Tosoni - Goodyear Dunlop Tires France

      Comment


      • #4
        Julien, Thank you! You put me on the right track. All is good now. And congratulations to the France national football team.

        José, I saw somewhere on my search through the internet that someone on some C/C# forum was using WmiGetErrorCodeText in their Excel example. I didn't find that it was helping me, and I forgot to take it out of my "failing code" example. I guess it was because it was Friday the 13th.
        ... .... . ... . . ... ... .... . .. ... .... .. ... .... .. .... ..

        n6jah @ yahoo.com

        Comment

        Working...
        X