none
AutoFilter Field

    Question

  • I can't seem to get AutoFilter Excel Automation in FoxPro

    oExcel.Worksheets("&csheet1").AutoFilterMode = .F.
    oExcel.Worksheets("&csheet1").Range("2:2").AutoFilter & this worked and enabled the filter on Excel
    oExcel.Worksheets("&csheet1").Range("2:2").AutoFilter Field:=6, Criteria1:=">=657000", Operator:=xlOr, Criteria2:="<=657999" && I have 7 fields total

    I get a syntax error on FoxPro.  Any suggestion on what I'm doing wrong?  Thanks in advance.

    Monday, April 12, 2010 10:17 PM

Answers

  • You cannot use named parameters in VFP (Field:=6, Criteria1:=">=657000" and such are named parameters). Instead you need to read the syntax of those commands in documentation and use the positional parameters. And keep away from using something like "&cheet1". It is an unnecessary abusing of & operator. Here is a sample filtering on country names where country name is less than "Germany" or equal to "UK":

    *** Constant Group: XlAutoFilterOperator
    #Define xlAnd                                             1
    #Define xlBottom10Items                                   4
    #Define xlBottom10Percent                                 6
    #Define xlOr                                              2
    #Define xlTop10Items                                      3
    #Define xlTop10Percent                                    5
    
    Local oExcel
    oExcel = Createobject("Excel.Application")
    With oExcel
      .WorkBooks.Add
      .Visible = .T.
      With .ActiveWorkBook.ActiveSheet
        VFP2Excel(_samples+'data\testdata.dbc','select * from customer',.Range('A1'))
    
        * Country alan indexini al
        Use (_samples+'data\customer') In 0
        Afields(aFieldList,'customer')
        Use In 'customer'
        lnFieldIndex = Ascan(aFieldList,'country',1,-1,1,1+2+4+8)
    
        * Country = 'UK' or Country < 'Germany' filtrele
        .Range('A1').AutoFilter(m.lnFieldIndex,"UK",xlOr,"<Germany")
    
      Endwith
    Endwith
    
    Function VFP2Excel
      Lparameters tcDataSource, tcSQL, toRange
      Local loConn As AdoDB.Connection, ;
        loRS As AdoDB.Recordset,;
        ix
      loConn = Createobject("Adodb.connection")
      loConn.ConnectionString = "Provider=VFPOLEDB;Data Source="+m.tcDataSource
      loConn.Open()
      loRS = loConn.Execute(m.tcSQL)
    
      For ix=1 To loRS.Fields.Count
        toRange.Offset(0,m.ix-1).Value = Proper(loRS.Fields(m.ix-1).Name)
        toRange.Offset(0,m.ix-1).Font.Bold = .T.
      Endfor
      toRange.Offset(1,0).CopyFromRecordSet( loRS )
      loRS.Close
      loConn.Close
    Endfunc
    

     


    • Marked as answer by jbalaros Friday, April 16, 2010 9:11 PM
    Tuesday, April 13, 2010 9:48 AM
  • I think I got it.  I was able to filter by:

     

    With oActiveSheet

              .AutoFilterMode = .F.
              .Range("D1").AutoFilter(4,"657*")   && where * is equlal to 'Begin With' in Excel   

    Endwith

    Just have to copy the filtered rows and paste it on sheet 2

    You are awesome, Cetin. You pointed me to the right path.  Thanks a million.

     

    • Marked as answer by jbalaros Friday, April 16, 2010 9:11 PM
    Friday, April 16, 2010 9:00 PM

All replies

  • You cannot use named parameters in VFP (Field:=6, Criteria1:=">=657000" and such are named parameters). Instead you need to read the syntax of those commands in documentation and use the positional parameters. And keep away from using something like "&cheet1". It is an unnecessary abusing of & operator. Here is a sample filtering on country names where country name is less than "Germany" or equal to "UK":

    *** Constant Group: XlAutoFilterOperator
    #Define xlAnd                                             1
    #Define xlBottom10Items                                   4
    #Define xlBottom10Percent                                 6
    #Define xlOr                                              2
    #Define xlTop10Items                                      3
    #Define xlTop10Percent                                    5
    
    Local oExcel
    oExcel = Createobject("Excel.Application")
    With oExcel
      .WorkBooks.Add
      .Visible = .T.
      With .ActiveWorkBook.ActiveSheet
        VFP2Excel(_samples+'data\testdata.dbc','select * from customer',.Range('A1'))
    
        * Country alan indexini al
        Use (_samples+'data\customer') In 0
        Afields(aFieldList,'customer')
        Use In 'customer'
        lnFieldIndex = Ascan(aFieldList,'country',1,-1,1,1+2+4+8)
    
        * Country = 'UK' or Country < 'Germany' filtrele
        .Range('A1').AutoFilter(m.lnFieldIndex,"UK",xlOr,"<Germany")
    
      Endwith
    Endwith
    
    Function VFP2Excel
      Lparameters tcDataSource, tcSQL, toRange
      Local loConn As AdoDB.Connection, ;
        loRS As AdoDB.Recordset,;
        ix
      loConn = Createobject("Adodb.connection")
      loConn.ConnectionString = "Provider=VFPOLEDB;Data Source="+m.tcDataSource
      loConn.Open()
      loRS = loConn.Execute(m.tcSQL)
    
      For ix=1 To loRS.Fields.Count
        toRange.Offset(0,m.ix-1).Value = Proper(loRS.Fields(m.ix-1).Name)
        toRange.Offset(0,m.ix-1).Font.Bold = .T.
      Endfor
      toRange.Offset(1,0).CopyFromRecordSet( loRS )
      loRS.Close
      loConn.Close
    Endfunc
    

     


    • Marked as answer by jbalaros Friday, April 16, 2010 9:11 PM
    Tuesday, April 13, 2010 9:48 AM
  • Thanks for the help.  I've been racking my brains these past few days finding a solution.  'appreciate your assistance.  You're right, the & is really unnecessary.  I'm tweaking my codes and will be using ActiveWorksheet instead.  I'm still learning the language so pardon my logic. 

    I'm basically trying to automate an Excel document. I'll see if I can apply the code above. Thanks again.

    Here's the complete code:

    #define xlLastCell 11
    #define xlMaximized -4137
    #define xlRangeAutoformatClassic2 2
    #define xlPortrait 1

    cFileName = "C:\Temp\fdnschv2\schrpt.xls"
    cHeader1 = "SCHOLARSHIP, STIPENDS, AWARDS PAID FOR THE WEEK/MONTH OF"
    cHeader2 = "SCHOLARSHIP PAID FOR THE WEEK/MONTH OF"
    cHeader3 = "STIPENDS PAID FOR THE WEEK/MONTH OF"
    cSheet1 = "Scholarship & Stipend"
    cSheet2 = "Scholarship"
    cSheet3 = "Stipend"
    cSavedPath = "\Desktop\"
    cSavedName = "Scholarship and Stipend Report"
    cDateRange = STRTRAN('&begdt',"/","") + '-' + STRTRAN('&enddt',"/","") && Removes character

    * User Profile - saves final document to \%userprofile%\desktop
    WSHShell = CreateObject("WScript.Shell")
    wProfile = WSHShell.ExpandEnvironmentStrings("%USERPROFILE%")

    * Launch Excel
    oExcel = CreateObject("Excel.Application")
    IF vartype(oExcel) != "O"
      * could not instantiate Excel object
      * show an error message here
      RETURN .F.
    ENDIF

    * Make Excel Visible
    oExcel.visible = .T.

    * Open Excel Workbook
    oExcel.SheetsInNewWorkBook = 1
    oWorkbook = oExcel.Workbooks.Open(cFileName)

    * Set Headings and Column Title on Active Sheet
    oActiveSheet = oExcel.ActiveSheet
    WITH oActiveSheet
        * Delete Columns
        .Range("A1").Entirecolumn.Delete     && PEID Column Deleted
        .Range("H1").Entirecolumn.Delete     && STATUS Column Deleted       
        * Add Column Title
        .Cells(1,1) = "RECIPIENT"        && A1
        .Cells(1,2) = "PROJNUM"            && B1
        .Cells(1,3) = "DESCRIPTION"        && C1
        .Cells(1,4) = "OBJCODE"            && D1
        .Cells(1,5) = "CHECKNO"            && E1
        .Cells(1,6) = "CHECKDT"            && F1
        .Cells(1,7) = "AMOUNT"            && G1
        .Cells(1,8) = "PROJNAME"        && H1
        .Cells(1,9) = "LAST4SSN"        && I1       
        * Move Columns - for each Column cut, Column range changes
        .Range("I1").Entirecolumn.Cut    && LAST4SSN inserted to B1
        .Range("B1").Entirecolumn.Insert      
        .Range("I1").Entirecolumn.Cut    && PROJNAME inserted to D1
        .Range("D1").Entirecolumn.Insert
        .Range("F1").Entirecolumn.Cut    && OBJCODE inserted to D1
        .Range("D1").Entirecolumn.Insert
        * Insert Extra Row for Header
        .Range("1:1").Entirerow.Insert  && Range("1:1")= From Row1 to Row1   
        * Insert Header
        .Cells(1,1) = '&cHeader1' + ' ' + '&begdt' + ' ' + '-' + ' ' + '&enddt'
        * Rename Active Worksheet
        .Name = '&cSheet1'
    ENDWITH

    * Additional Worksheets with Sheet Header and Column Titles
    WITH oExcel
        * Add Sheet2
        .Worksheets.Add.Name = '&cSheet2'
        .Worksheets('&cSheet1').Range("2:2").Entirerow.Copy
        .Worksheets('&cSheet2').Range("2:2").Entirerow.Insert
        .Worksheets('&cSheet2').Cells(1,1) = '&cHeader2' + ' ' + '&begdt' + ' ' + '-' + ' ' + '&enddt'
        * Add Sheet3
        .Worksheets.Add.Name = '&cSheet3'
        .Worksheets('&cSheet1').Range("2:2").Entirerow.Copy
        .Worksheets('&cSheet3').Range("2:2").Entirerow.Insert
        .Worksheets('&cSheet3').Cells(1,1) = '&cHeader3' + ' ' + '&begdt' + ' ' + '-' + ' ' + '&enddt'
        * Moves Sheet1 to first tab
        .Worksheets('&cSheet1').Move(oExcel.Worksheets.Item(1))
        .Worksheets('&cSheet2').Move(oExcel.Worksheets.Item(2))
        * Formats Selected Columns
        .Worksheets('&cSheet1').Columns("H:H").NumberFormat = "mm/dd/yyyy"
        .Worksheets('&cSheet1').Columns("I:I").NumberFormat = "#,##0.00;[Red](#,##0.00) "    && Amount in Red is oh_status = 'RV'
        .Worksheets('&cSheet1').Select    && Select Sheet1 as ActiveSheet
    ENDWITH

    * Filter Scholarship
    WITH oExcel
        .Worksheets("&csheet1").AutoFilterMode = .F.
        .Worksheets("&csheet1").Range("2:2").AutoFilter
        .Worksheets("&csheet1").Range("2:2").AutoFilter Field:=4, Criteria1:=">=657000", Operator:=xlOr, Criteria2:="<=657999"
    ENDWITH
    *!*        .Worksheets("&csheet1").Select.Entirerow.Copy
    *!*        .Worksheets('&cSheet2').Range("3:3").Entirerow.Insert
    *!*    ENDWITH

    RETURN

    WITH oExcel
        * Save Excel Document
        .Activeworkbook.SaveAs('&wProfile' + '&cSavedPath' + '&cSavedName' + ' ' + '&cDateRange')
    ENDWITH

    Friday, April 16, 2010 6:55 PM
  • I think I got it.  I was able to filter by:

     

    With oActiveSheet

              .AutoFilterMode = .F.
              .Range("D1").AutoFilter(4,"657*")   && where * is equlal to 'Begin With' in Excel   

    Endwith

    Just have to copy the filtered rows and paste it on sheet 2

    You are awesome, Cetin. You pointed me to the right path.  Thanks a million.

     

    • Marked as answer by jbalaros Friday, April 16, 2010 9:11 PM
    Friday, April 16, 2010 9:00 PM
  • Thanks for the help.  I've been racking my brains these past few days finding a solution.  'appreciate your assistance.  You're right, the & is really unnecessary.  I'm tweaking my codes and will be using ActiveWorksheet instead.  I'm still learning the language so pardon my logic. 

    I'm basically trying to automate an Excel document. I'll see if I can apply the code above. Thanks again.

    Here's the complete code:

    #define xlLastCell 11
    #define xlMaximized -4137
    #define xlRangeAutoformatClassic2 2
    #define xlPortrait 1

    cFileName = "C:\Temp\fdnschv2\schrpt.xls"
    cHeader1 = "SCHOLARSHIP, STIPENDS, AWARDS PAID FOR THE WEEK/MONTH OF"
    cHeader2 = "SCHOLARSHIP PAID FOR THE WEEK/MONTH OF"
    cHeader3 = "STIPENDS PAID FOR THE WEEK/MONTH OF"
    cSheet1 = "Scholarship & Stipend"
    cSheet2 = "Scholarship"
    cSheet3 = "Stipend"
    cSavedPath = "\Desktop\"
    cSavedName = "Scholarship and Stipend Report"
    cDateRange = STRTRAN('&begdt',"/","") + '-' + STRTRAN('&enddt',"/","") && Removes character

    * User Profile - saves final document to \%userprofile%\desktop
    WSHShell = CreateObject("WScript.Shell")
    wProfile = WSHShell.ExpandEnvironmentStrings("%USERPROFILE%")

    * Launch Excel
    oExcel = CreateObject("Excel.Application")
    IF vartype(oExcel) != "O"
      * could not instantiate Excel object
      * show an error message here
      RETURN .F.
    ENDIF

    * Make Excel Visible
    oExcel.visible = .T.

    * Open Excel Workbook
    oExcel.SheetsInNewWorkBook = 1
    oWorkbook = oExcel.Workbooks.Open(cFileName)

    * Set Headings and Column Title on Active Sheet
    oActiveSheet = oExcel.ActiveSheet
    WITH oActiveSheet
        * Delete Columns
        .Range("A1").Entirecolumn.Delete     && PEID Column Deleted
        .Range("H1").Entirecolumn.Delete     && STATUS Column Deleted       
        * Add Column Title
        .Cells(1,1) = "RECIPIENT"        && A1
        .Cells(1,2) = "PROJNUM"            && B1
        .Cells(1,3) = "DESCRIPTION"        && C1
        .Cells(1,4) = "OBJCODE"            && D1
        .Cells(1,5) = "CHECKNO"            && E1
        .Cells(1,6) = "CHECKDT"            && F1
        .Cells(1,7) = "AMOUNT"            && G1
        .Cells(1,8) = "PROJNAME"        && H1
        .Cells(1,9) = "LAST4SSN"        && I1       
        * Move Columns - for each Column cut, Column range changes
        .Range("I1").Entirecolumn.Cut    && LAST4SSN inserted to B1
        .Range("B1").Entirecolumn.Insert      
        .Range("I1").Entirecolumn.Cut    && PROJNAME inserted to D1
        .Range("D1").Entirecolumn.Insert
        .Range("F1").Entirecolumn.Cut    && OBJCODE inserted to D1
        .Range("D1").Entirecolumn.Insert
        * Insert Extra Row for Header
        .Range("1:1").Entirerow.Insert  && Range("1:1")= From Row1 to Row1   
        * Insert Header
        .Cells(1,1) = '&cHeader1' + ' ' + '&begdt' + ' ' + '-' + ' ' + '&enddt'
        * Rename Active Worksheet
        .Name = '&cSheet1'
    ENDWITH

    * Additional Worksheets with Sheet Header and Column Titles
    WITH oExcel
        * Add Sheet2
        .Worksheets.Add.Name = '&cSheet2'
        .Worksheets('&cSheet1').Range("2:2").Entirerow.Copy
        .Worksheets('&cSheet2').Range("2:2").Entirerow.Insert
        .Worksheets('&cSheet2').Cells(1,1) = '&cHeader2' + ' ' + '&begdt' + ' ' + '-' + ' ' + '&enddt'
        * Add Sheet3
        .Worksheets.Add.Name = '&cSheet3'
        .Worksheets('&cSheet1').Range("2:2").Entirerow.Copy
        .Worksheets('&cSheet3').Range("2:2").Entirerow.Insert
        .Worksheets('&cSheet3').Cells(1,1) = '&cHeader3' + ' ' + '&begdt' + ' ' + '-' + ' ' + '&enddt'
        * Moves Sheet1 to first tab
        .Worksheets('&cSheet1').Move(oExcel.Worksheets.Item(1))
        .Worksheets('&cSheet2').Move(oExcel.Worksheets.Item(2))
        * Formats Selected Columns
        .Worksheets('&cSheet1').Columns("H:H").NumberFormat = "mm/dd/yyyy"
        .Worksheets('&cSheet1').Columns("I:I").NumberFormat = "#,##0.00;[Red](#,##0.00) "    && Amount in Red is oh_status = 'RV'
        .Worksheets('&cSheet1').Select    && Select Sheet1 as ActiveSheet
    ENDWITH

    * Filter Scholarship
    WITH oExcel
        .Worksheets("&csheet1").AutoFilterMode = .F.
        .Worksheets("&csheet1").Range("2:2").AutoFilter
        .Worksheets("&csheet1").Range("2:2").AutoFilter Field:=4, Criteria1:=">=657000", Operator:=xlOr, Criteria2:="<=657999"
    ENDWITH
    *!*        .Worksheets("&csheet1").Select.Entirerow.Copy
    *!*        .Worksheets('&cSheet2').Range("3:3").Entirerow.Insert
    *!*    ENDWITH

    RETURN

    WITH oExcel
        * Save Excel Document
        .Activeworkbook.SaveAs('&wProfile' + '&cSavedPath' + '&cSavedName' + ' ' + '&cDateRange')
    ENDWITH

    I am not sure if this is a question. If it is:

    #define xlLastCell 11
    #define xlMaximized -4137
    #define xlRangeAutoformatClassic2 2
    #define xlPortrait 1
    
    cFileName = "C:\Temp\fdnschv2\schrpt.xls"
    cHeader1 = "SCHOLARSHIP, STIPENDS, AWARDS PAID FOR THE WEEK/MONTH OF"
    cHeader2 = "SCHOLARSHIP PAID FOR THE WEEK/MONTH OF"
    cHeader3 = "STIPENDS PAID FOR THE WEEK/MONTH OF"
    cSheet1 = "Scholarship & Stipend"
    cSheet2 = "Scholarship"
    cSheet3 = "Stipend"
    cSavedPath = "Desktop\"
    cSavedName = "Scholarship and Stipend Report"
    cDateRange = STRTRAN(m.begdt,"/","") + '-' + STRTRAN(m.enddt,"/","") && Removes character
    
    * User Profile - saves final document to \%userprofile%\desktop
    wProfile = GETENV("USERPROFILE")
    
    * Launch Excel
    ON ERROR lHadError = .T.
    oExcel = CreateObject("Excel.Application")
    ON ERROR
    
    IF m.lHadError
     * could not instantiate Excel object
     * show an error message here
     RETURN .F.
    ENDIF
    
    * Make Excel Visible
    oExcel.visible = .T.
    
    * Open Excel Workbook
    oExcel.SheetsInNewWorkBook = 1
    oWorkbook = oExcel.Workbooks.Open(m.cFileName)
    
    * Set Headings and Column Title on Active Sheet
    WITH oExcel.ActiveWorkbook.ActiveSheet
      * Delete Columns
      .Range("A:A").Entirecolumn.Delete   && PEID Column Deleted
      .Range("H:H").Entirecolumn.Delete   && STATUS Column Deleted    
      * Add Column Title
      .Cells(1,1) = "RECIPIENT"    && A1
      .Cells(1,2) = "PROJNUM"      && B1
      .Cells(1,3) = "DESCRIPTION"    && C1
      .Cells(1,4) = "OBJCODE"      && D1
      .Cells(1,5) = "CHECKNO"      && E1
      .Cells(1,6) = "CHECKDT"      && F1
      .Cells(1,7) = "AMOUNT"      && G1
      .Cells(1,8) = "PROJNAME"    && H1
      .Cells(1,9) = "LAST4SSN"    && I1    
      * Move Columns - for each Column cut, Column range changes
      .Range("I1").Entirecolumn.Cut  && LAST4SSN inserted to B1
      .Range("B1").Entirecolumn.Insert   
      .Range("I1").Entirecolumn.Cut  && PROJNAME inserted to D1
      .Range("D1").Entirecolumn.Insert
      .Range("F1").Entirecolumn.Cut  && OBJCODE inserted to D1
      .Range("D1").Entirecolumn.Insert
      * Insert Extra Row for Header
      .Range("1:1").Entirerow.Insert && Range("1:1")= From Row1 to Row1  
      * Insert Header
      .Cells(1,1) = m.cHeader1 + ' ' + m.begdt + ' - ' + m.enddt
      * Rename Active Worksheet
      .Name = m.cSheet1
    ENDWITH 
    
    * Additional Worksheets with Sheet Header and Column Titles
    WITH oExcel.ActiveWorkbook
      * Add Sheet2
      .Worksheets.Add.Name = m.cSheet2
      .Worksheets(m.cSheet1).Range("2:2").Entirerow.Copy
      .Worksheets(m.cSheet2).Range("2:2").Entirerow.Insert
      .Worksheets(m.cSheet2).Cells(1,1) = m.cHeader2 + ' ' + m.begdt + ' - ' + m.enddt
      * Add Sheet3
      .Worksheets.Add.Name = m.cSheet3
      .Worksheets(m.cSheet1).Range("2:2").Entirerow.Copy
      .Worksheets(m.cSheet3).Range("2:2").Entirerow.Insert
      .Worksheets(m.cSheet3).Cells(1,1) = m.cHeader3 + ' ' + m.begdt + ' - ' + m.enddt
      * Moves Sheet1 to first tab
      .Worksheets(m.cSheet1).Move(oExcel.Worksheets.Item(1))
      .Worksheets(m.cSheet2).Move(oExcel.Worksheets.Item(2))
      * Formats Selected Columns
      .Worksheets(m.cSheet1).Columns("H:H").NumberFormat = "mm/dd/yyyy"
      .Worksheets(m.cSheet1).Columns("I:I").NumberFormat = "#,##0.00;[Red](#,##0.00) "  && Amount in Red is oh_status = 'RV'
      .Worksheets(m.cSheet1).Activate  && Select Sheet1 as ActiveSheet
    ENDWITH 
    
    * Filter Scholarship
    oExcel.ActiveWorkbook.Worksheets(m.csheet1).Range("A2").AutoFilter( 4, ">=657000", xlOr, "<=657999" )
    RETURN 
    
    WITH oExcel
      * Save Excel Document
      .Activeworkbook.SaveAs( ADDBS(ADDBS(m.wProfile) + m.cSavedPath) + m.cSavedName + ' ' + m.cDateRange + '.xls')
    ENDWITH

    Friday, April 16, 2010 10:53 PM
  • Wow... that looks way cleaner than my code. Thanks.  For whatever reason, I can't get AutoFilter(4,">=657000", xlOr,"<=657999") to work.  It's coming up with blank instead of x amount of rows. That's why I had .Range("D1").AutoFilter(4,"658*") instead.  Now, I'm having issues copying the filtered rows to sheet 2.

    .Worksheets(m.csheet1).Range("3:65536").Entirerow.Copy   && This Works

    .Worksheets(m.cSheet2).Range("3:3").Entirerow.Insert         && But won't paste

    Friday, April 16, 2010 11:13 PM
  • Before I was sort of careless and thought that filter was really what you wanted, didn't pay attention to expression. 

     

    ">=657000", xlOr,"<=657999" means either greater than or equal to 657000 OR less than or equal to 657999. That rule says to include all numbers ( 1 for example wins because it is less than 657999, 1 million wins because it is greater than 657000 ). You should instead use AND - xlAnd ).

    I don't know why it is not working for you:

    Rand(-1)
    Create Cursor sampleData (randomDate d, amount i)
    For ix = 0 To 4000
     Insert Into sampleData Values (Date()-Int(Rand()*1000), 655000+m.ix)
    Endfor
    Copy To Array excelData
    
    
    *** Constant Group: XlAutoFilterOperator
    #Define xlAnd                       1
    #Define xlBottom10Items                  4
    #Define xlBottom10Percent                 6
    #Define xlOr                       2
    #Define xlTop10Items                   3
    #Define xlTop10Percent                  5
    
    oExcel = Createobject('Excel.Application')
    oExcel.Workbooks.Add()
    oExcel.Visible = .T.
    With oExcel.ActiveWorkbook.ActiveSheet
     .Range('A1').Value = 'Date'
     .Range('B1').Value = 'Amount'
     .Range( .Cells(2,1), .Cells(Alen(excelData,1)+1, Alen(excelData,2)) ).Value = getArrayRef('excelData')
    Endwith
    
    oExcel.Worksheets.Add(Null,oExcel.ActiveWorkbook.ActiveSheet)
    oExcel.Worksheets('Sheet1').Range("3:100").Entirerow.Copy  && This Works
    oExcel.Worksheets('Sheet2').Range("A3").Entirerow.Insert()     && But won't paste
    
    oExcel.Worksheets('Sheet1').Range('B1').AutoFilter( 2, '>=657000', xlAnd, '<=657999')
    Return
    
    Function getArrayRef(tcArrayName)
     Return @&tcArrayName

     

    Here is something which I think that might be called a tip and to me was much more helpful than macro recording:

    -In your code at a point where you don't know the exact sequence put a set step on (say before the line with "..EntireRow.Copy" )

    -Size your Excel and VFP windows so that you can see both (in VFP you wold need command window which can float)

    -In command window if you type oExcel. you would get intellisense to excel. After some more levels you lose intellisense. If you do something like this:

    loSheet = oExcel.ActiveWorkBook.Worksheets('sheet1')

    and then type:

    loSheet.

    you get intellisense back again for that level and you can extend to many levels this way. Good part as you execute commands at command window you see the results in Excel window right away. When you are satisfied you can copy the lines from command window into your real code. 

    That is kind 'interactive automation' that I use sometimes (works with other COM too). Hope helps.



    Saturday, April 17, 2010 12:01 PM
  • Thanks again.  I tried the xlAnd and it still won't filter right.  I still get 0 of XX rows.  Will work on the paste the filtered row to sheet2 today.  'hopefully get this done.  'appreciate your assistance.
    Monday, April 19, 2010 5:20 PM
  • Got it...

     

    Here's the code to paste.

     

    * Filter Scholarship
    WITH oExcel.ActiveWorkBook   
        .Worksheets('&csheet1').Range("D1").AutoFilter(4,"657*")  && where 4 is column# and * is equal to 'Begin With' in Excel       
        .Worksheets('&csheet1').Range("3:6545").Entirerow.Copy   
        .Worksheets('&cSheet2').Range("A3").Entirerow.PasteSpecial
    ENDWITH

    Monday, April 19, 2010 11:12 PM
  • Get rid of those macros. They're just slowing you down:

    * Filter Scholarship
    WITH oExcel.ActiveWorkBook   
        .Worksheets(csheet1).Range("D1").AutoFilter(4,"657*")  && where 4 is column# and * is equal to 'Begin With' in Excel       
        .Worksheets(csheet1).Range("3:6545").Entirerow.Copy   
        .Worksheets(cSheet2).Range("A3").Entirerow.PasteSpecial
    ENDWITH

     

    Tamar

    Tuesday, April 20, 2010 8:20 PM
    Answerer
  • Not sure what you meant by getting rid of the macros.  Is there an alternative way of doing this?  I'm sure there's a better way of writing the above codes but with my limited knowledge, this is what I came up with.  With the help of experts like yourself and Cetin, I'm getting comfortable writing small codes.  Prolly not the most efficient way of writing it though... =).
    Wednesday, April 21, 2010 5:41 PM
  • I showed you the alternative in my answer. You had code like:

        .Worksheets('&csheet1').Range("3:6545").Entirerow.Copy   

    You don't need the & macro or the quotes. Just use:

        .Worksheets(csheet1).Range("3:6545").Entirerow.Copy   

     

    Tamar

    Wednesday, April 21, 2010 8:26 PM
    Answerer
  • I see.  Here's the working end result.  Thanks to both Cetin and Tamar.

    #define xlLastCell 11
    #define xlMaximized -4137
    #define xlRangeAutoformatClassic2 2
    #define xlPortrait 1
    #define xlOr 2
    #define xlAnd 1

    cFileName = "C:\Temp\fdnschv2\schrpt.xls"
    cHeader1 = "SCHOLARSHIP, STIPENDS, AWARDS PAID FROM"
    cHeader2 = "SCHOLARSHIP PAID FROM"
    cHeader3 = "STIPENDS PAID FROM"
    cSheet1 = "Scholarship & Stipend"
    cSheet2 = "Scholarship"
    cSheet3 = "Stipend"
    cSavedPath = "\Desktop\"
    cSavedName = "Scholarship and Stipend Report from"
    cDateRange = STRTRAN(begdt,"/","") + '-' + STRTRAN(enddt,"/","")

    * User Profile - saves final document to \%userprofile%\desktop
    WSHShell = CreateObject("WScript.Shell")
    wProfile = WSHShell.ExpandEnvironmentStrings("%USERPROFILE%")

    * Launch Excel
    oExcel = CreateObject("Excel.Application")
    IF vartype(oExcel) != "O"
      * could not instantiate Excel object
      * show an error message here
      RETURN .F.
    ENDIF

    WITH oExcel
        * Make Excel Visible
        .Visible = .T.
        * Open Excel Workbook
        .Workbooks.Open(cFileName)
            WITH .ActiveWorkBook
                * Delete Columns
                .ActiveSheet.Range("A1").Entirecolumn.Delete
                .ActiveSheet.Range("H1").Entirecolumn.Delete 
                * Add Column Title
                .ActiveSheet.Cells(1,1) = "RECIPIENT"
                .ActiveSheet.Cells(1,2) = "PROJNUM"      
                .ActiveSheet.Cells(1,3) = "DESCRIPTION"    
                .ActiveSheet.Cells(1,4) = "OBJCODE"         
                .ActiveSheet.Cells(1,5) = "CHECKNO"         
                .ActiveSheet.Cells(1,6) = "CHECKDT"        
                .ActiveSheet.Cells(1,7) = "AMOUNT"         
                .ActiveSheet.Cells(1,8) = "PROJNAME"     
                .ActiveSheet.Cells(1,9) = "LAST4"        
                * Move Columns - for each Column cut, Column range changes
                .ActiveSheet.Range("I1").Entirecolumn.Cut  
                .ActiveSheet.Range("B1").Entirecolumn.Insert      
                .ActiveSheet.Range("I1").Entirecolumn.Cut   
                .ActiveSheet.Range("D1").Entirecolumn.Insert
                .ActiveSheet.Range("F1").Entirecolumn.Cut   
                .ActiveSheet.Range("D1").Entirecolumn.Insert
                * Insert Extra Row for Header
                .ActiveSheet.Range("1:1").Entirerow.Insert 
                * Insert Header
                .ActiveSheet.Cells(1,1) = cHeader1 + ' ' + begdt + ' ' + '-' + ' ' + enddt
                * Rename Active Worksheet
                .ActiveSheet.Name = cSheet1
                * Add Sheet2
                .Worksheets.Add.Name = cSheet2
                .Worksheets(cSheet1).Range("2:2").Entirerow.Copy
                .Worksheets(cSheet2).Range("2:2").Entirerow.Insert
                .Worksheets(cSheet2).Cells(1,1) = cHeader2 + ' ' + begdt + ' ' + '-' + ' ' + enddt
                * Add Sheet3
                .Worksheets.Add.Name = cSheet3
                .Worksheets(cSheet1).Range("2:2").Entirerow.Copy
                .Worksheets(cSheet3).Range("2:2").Entirerow.Insert
                .Worksheets(cSheet3).Cells(1,1) = cHeader3 + ' ' + begdt + ' ' + '-' + ' ' + enddt
                * Moves Sheet1 to first tab
                .Worksheets(cSheet1).Move(oExcel.Worksheets.Item(1))
                .Worksheets(cSheet2).Move(oExcel.Worksheets.Item(2))
                .Worksheets(cSheet1).Select 
                * Formats Selected Columns
                .Worksheets(cSheet1).Columns("H:H").NumberFormat = "mm/dd/yyyy"
                .Worksheets(cSheet1).Columns("I:I").NumberFormat = "#,##0.00;[Red](#,##0.00) "           
                * Filter Scholarship - Copy and PasteSpecial
                .Worksheets(csheet1).Range("D1").AutoFilter(4,"657*")
                .Worksheets(csheet1).Range("3:6545").Entirerow.Copy   
                .Worksheets(cSheet2).Range("A3").Entirerow.PasteSpecial
                * Filter Stipend - Copy and PasteSpecial
                .Worksheets(csheet1).Range("D1").AutoFilter(4,"658*")
                .Worksheets(csheet1).Range("3:6545").Entirerow.Copy
                .Worksheets(cSheet3).Range("A3").Entirerow.PasteSpecial
                * Disable Autofilter
                .Worksheets(csheet1).AutoFilterMode = .F.
                * Save Excel Document   
                .SaveAs(wProfile + cSavedPath + cSavedName + ' ' + cDateRange)
            ENDWITH
    ENDWITH


    • Edited by jbalaros Thursday, April 22, 2010 10:11 PM
    Thursday, April 22, 2010 4:40 PM
  • You still have unnecessary macros. Any time you write '&variable', chances are excellent that you don't need the macro at all and can just use the variable.

    Tamar

    Thursday, April 22, 2010 8:26 PM
    Answerer
  • Shoot, my bad.  I didn't see that.  I took it off and it worked just fine.

    Also, is there a way to loop around the code below and just copy the rows that has data on it instead of having a Range(3:6556)? Let's say 657 filter came up to 200 rows, I'd rather just copy the 200 rows instead of 6545.

      * Filter Scholarship - Copy and PasteSpecial
                .Worksheets(csheet1).Range("D1").AutoFilter(4,"657*")
                .Worksheets(csheet1).Range("3:6545").Entirerow.Copy   
                .Worksheets(cSheet2).Range("A3").Entirerow.PasteSpecial

     

     

    Thursday, April 22, 2010 10:06 PM
  • Check out UsedRange. It tells you which part of the worksheet is in use.

    Tamar

    Friday, April 23, 2010 8:30 PM
    Answerer
  • Got it.  Thanks a million.  Worked like a charm...


    #define xlLastCell 11
    #define xlMaximized -4137
    #define xlRangeAutoformatClassic2 2
    #define xlPortrait 1
    #define xlOr 2
    #define xlAnd 1

    cFileName = "C:\Temp\fdnschv2\schrpt.xls"
    cHeader1 = "SCHOLARSHIP, STIPENDS, AWARDS PAID FROM"
    cHeader2 = "SCHOLARSHIP PAID FROM"
    cHeader3 = "STIPENDS PAID FROM"
    cSheet1 = "Scholarship & Stipend"
    cSheet2 = "Scholarship"
    cSheet3 = "Stipend"
    cSavedPath = "\Desktop\"
    cSavedName = "Scholarship and Stipend Report from"
    cDateRange = STRTRAN(dBegdt,"/","") + '-' + STRTRAN(dEnddt,"/","")


    * User Profile - saves final document to \%userprofile%\desktop
    WSHShell = CreateObject("WScript.Shell")
    wProfile = WSHShell.ExpandEnvironmentStrings("%USERPROFILE%")

    * Launch Excel
    oExcel = CreateObject("Excel.Application")
    IF vartype(oExcel) != "O"
      * could not instantiate Excel object
      * show an error message here
      RETURN .F.
    ENDIF

    WITH oExcel
        * Make Excel Visible
        .Visible = .T.
        * Open Excel Workbook
        .Workbooks.Open(cFileName)
            WITH .ActiveWorkBook
                * Delete Columns
                .ActiveSheet.Range("A1").Entirecolumn.Delete    
                .ActiveSheet.Range("H1").Entirecolumn.Delete     
                * Add Column Title
                .ActiveSheet.Cells(1,1) = "RECIPIENT"      
                .ActiveSheet.Cells(1,2) = "PROJNUM"          
                .ActiveSheet.Cells(1,3) = "DESCRIPTION"      
                .ActiveSheet.Cells(1,4) = "OBJCODE"          
                .ActiveSheet.Cells(1,5) = "CHECKNO"          
                .ActiveSheet.Cells(1,6) = "CHECKDT"          
                .ActiveSheet.Cells(1,7) = "AMOUNT"         
                .ActiveSheet.Cells(1,8) = "PROJNAME"      
                .ActiveSheet.Cells(1,9) = "LAST4SSN"            
                * Move Columns - for each Column cut, Column range changes
                .ActiveSheet.Range("I1").Entirecolumn.Cut 
                .ActiveSheet.Range("B1").Entirecolumn.Insert      
                .ActiveSheet.Range("I1").Entirecolumn.Cut
                .ActiveSheet.Range("D1").Entirecolumn.Insert
                .ActiveSheet.Range("F1").Entirecolumn.Cut
                .ActiveSheet.Range("D1").Entirecolumn.Insert
                * Insert Extra Row for Header
                .ActiveSheet.Range("1:1").Entirerow.Insert 
                * Insert Header
                .ActiveSheet.Cells(1,1) = cHeader1 + ' ' + dBegdt + ' ' + '-' + ' ' + dEnddt
                * Rename Active Worksheet
                .ActiveSheet.Name = cSheet1
                * Add Sheets
                .Worksheets.Add.Name = cSheet2
                .Worksheets.Add.Name = cSheet3
                * Moves Sheet1 to first tab
                .Worksheets(cSheet1).Move(oExcel.Worksheets.Item(1))
                .Worksheets(cSheet2).Move(oExcel.Worksheets.Item(2))           
                * Formats Selected Columns
                .Worksheets(cSheet1).Columns("H:H").NumberFormat = "mm/dd/yyyy"
                .Worksheets(cSheet1).Columns("I:I").NumberFormat = "#,##0.00;[Red](#,##0.00) "           
                * Filter Scholarship - Copy and PasteSpecial
                .Worksheets(csheet1).Range("D1").AutoFilter(4,"657*")
                .Worksheets(csheet1).UsedRange.Entirerow.Copy
                .Worksheets(cSheet2).Range("A1").Entirerow.PasteSpecial
                .Worksheets(cSheet2).Cells(1,1) = cHeader2 + ' ' + dBegdt + ' ' + '-' + ' ' + dEnddt
                * Filter Stipend - Copy and PasteSpecial
                .Worksheets(csheet1).Range("D1").AutoFilter(4,"658*")
                .Worksheets(csheet1).UsedRange.Entirerow.Copy
                .Worksheets(cSheet3).Range("A1").Entirerow.PasteSpecial
                .Worksheets(cSheet3).Cells(1,1) = cHeader3 + ' ' + dBegdt + ' ' + '-' + ' ' + dEnddt
                * Set Sheet1 as Activesheet
                .Worksheets(cSheet1).Select
                * Disable Autofilter
                .Worksheets(csheet1).AutoFilterMode = .F.
                * Save Excel Document   
                .SaveAs(wProfile + cSavedPath + cSavedName + ' ' + cDateRange)
            ENDWITH
    ENDWITH

     

     

    Friday, April 23, 2010 11:29 PM