Results 1 to 10 of 10
  1. #1
    Join Date
    Nov 2007
    Posts
    93

    Unanswered: excel automation via access

    hello freinds !!
    i am trying to export access report to excel but whle doing these i am loosing the format

    in order to have the same ... i am making use of excel objects to format the excel sheet

    my concern is just 2 compare 2 colums which are adjacent to each other and if there value is greate then display the font in red color ...

    for example :

    header1 header2
    10 20

    so it shuld highlight 20 in red color in excel sheet

    the code i wrote is these


    Dim appXL As Excel.Application
    Dim wkbXL As Excel.Workbook
    Dim wksXL As Excel.Worksheet

    Set wkbXL = GetObject("t.xls")
    Set appXL = wkbXL.Parent
    Set wksXL = wkbXL.Worksheets("sheet1")

    appXL.Visible = True
    wkbXL.Windows(1).Visible = True

    With appXL

    Dim I_Last_Row_Sheet1 As Integer
    Dim I_Last_Row_Sheet2 As Integer
    Dim i, J As Integer
    Dim Value_Search1, Value_Search2 As Variant
    Dim Header, c As Variant

    I_Last_Row_Sheet1 = appXL.Sheets("sheet1").Range("g5000").End(xlUp).Ro w
    I_Last_Row_Sheet2 = appXL.Sheets("sheet1").Range("h5000").End(xlUp).Ro w
    '
    For J = 2 To I_Last_Row_Sheet2
    Value_Search2 = appXL.Sheets("sheet1").Cells(J, "H")
    Value_Search2 = UCase(Value_Search2)

    For i = 2 To I_Last_Row_Sheet1
    Value_Search1 = appXL.Sheets("sheet1").Cells(i, "G")
    Value_Search1 = UCase(Value_Search1)

    If (Value_Search1 > Value_Search2) Then
    *** until here its workign great .. i am able to get the values from excel but arent sure how to give the for loop or any possible solution to these ***

    End With

    appXL.DisplayAlerts = False
    appXL.SaveWorkspace
    appXL.Quit
    Set wksXL = Nothing
    Set wkbXL = Nothing
    Set appXL = Nothing

    Err_Handler:

    End Sub



    any suggestions would be appreciated

    thanks

  2. #2
    Join Date
    Apr 2004
    Location
    Derbyshire, UK
    Posts
    789
    Provided Answers: 1
    Quote Originally Posted by sam_01
    hello freinds !!
    i am trying to export access report to excel but whle doing these i am loosing the format

    in order to have the same ... i am making use of excel objects to format the excel sheet

    my concern is just 2 compare 2 colums which are adjacent to each other and if there value is greate then display the font in red color ...

    for example :

    header1 header2
    10 20

    so it shuld highlight 20 in red color in excel sheet

    the code i wrote is these


    Dim appXL As Excel.Application
    Dim wkbXL As Excel.Workbook
    Dim wksXL As Excel.Worksheet

    Set wkbXL = GetObject("t.xls")
    Set appXL = wkbXL.Parent
    Set wksXL = wkbXL.Worksheets("sheet1")

    appXL.Visible = True
    wkbXL.Windows(1).Visible = True

    With appXL

    Dim I_Last_Row_Sheet1 As Integer
    Dim I_Last_Row_Sheet2 As Integer
    Dim i, J As Integer
    Dim Value_Search1, Value_Search2 As Variant
    Dim Header, c As Variant

    I_Last_Row_Sheet1 = appXL.Sheets("sheet1").Range("g5000").End(xlUp).Ro w
    I_Last_Row_Sheet2 = appXL.Sheets("sheet1").Range("h5000").End(xlUp).Ro w
    '
    For J = 2 To I_Last_Row_Sheet2
    Value_Search2 = appXL.Sheets("sheet1").Cells(J, "H")
    Value_Search2 = UCase(Value_Search2)

    For i = 2 To I_Last_Row_Sheet1
    Value_Search1 = appXL.Sheets("sheet1").Cells(i, "G")
    Value_Search1 = UCase(Value_Search1)

    If (Value_Search1 > Value_Search2) Then
    *** until here its workign great .. i am able to get the values from excel but arent sure how to give the for loop or any possible solution to these ***

    End With

    appXL.DisplayAlerts = False
    appXL.SaveWorkspace
    appXL.Quit
    Set wksXL = Nothing
    Set wkbXL = Nothing
    Set appXL = Nothing

    Err_Handler:

    End Sub



    any suggestions would be appreciated

    thanks
    Hi

    Perhaps this will do it

    If (Value_Search1 > Value_Search2) Then appXL.Sheets("sheet1").Cells(J, "H").Font.ColorIndex = 3


    ??


    MTB

    ps you seem to be missing a Next i and a Next J !!

    Also, with code as written, the 'With appXL/End With' are redundant.

  3. #3
    Join Date
    Nov 2007
    Posts
    93

    excel automation via access

    thanks for the reply .. appreciate it

    i tried to work around with the code .. but it seems like its storing the value of i and comparing with all values of j then switching its value with i and again comparing with all j's

    bt i am looking for something like

    header1 header2
    10 20
    20 30
    so values of header2 should be in red color upon comparisiion

    here is my code :
    Private Sub Command6_Click()

    'On Error GoTo Err_Handler

    Dim appXL As Excel.Application
    Dim wkbXL As Excel.Workbook
    Dim wksXL As Excel.Worksheet

    Set wkbXL = GetObject("C:\Documents and Settings\User\Desktop\inventory_all.xls")
    Set appXL = wkbXL.Parent
    Set wksXL = wkbXL.Worksheets("inventory_all")

    appXL.Visible = True
    wkbXL.Windows(1).Visible = True

    With appXL

    Dim I_Last_Row_Sheet1 As Integer
    Dim I_Last_Row_Sheet2 As Integer
    Dim i, J As Integer
    Dim Value_Search1, Value_Search2 As Variant
    Dim Header, c As Variant

    I_Last_Row_Sheet1 = appXL.Sheets("inventory_all").End(xlUp).Row
    I_Last_Row_Sheet2 = appXL.Sheets("inventory_all").End(xlUp).Row
    '
    For i = 2 To I_Last_Row_Sheet1
    Value_Search1 = appXL.Sheets("inventory_all").Cells(i, "G")
    Value_Search1 = UCase(Value_Search1)

    For J = 2 To I_Last_Row_Sheet2
    Value_Search2 = appXL.Sheets("inventory_all").Cells(J, "H")
    Value_Search2 = UCase(Value_Search2)


    If (Value_Search1 < Value_Search2) Then
    appXL.Sheets("inventory_all").Cells(J, "H").Font.ColorIndex = 3
    End If

    ///the concept of next here i believe is getting wrong //

    Next i '
    Next J
    End With

    appXL.DisplayAlerts = False
    appXL.SaveWorkspace
    appXL.Quit
    Set wksXL = Nothing
    Set wkbXL = Nothing
    Set appXL = Nothing

    Err_Handler:

    End Sub

    and at the same time its not killing the excel object once its done

  4. #4
    Join Date
    Dec 2002
    Location
    Préverenges, Switzerland
    Posts
    3,740
    its not killing the excel object once its done

    consider using a safer tidyup - the way you have it now most runtime errors will skip your tidyup and fall off the end of the sub via your "error handler"

    on error goto err_mystuff
    'blah whatever you are doing
    'blah whatever you are doing
    'blah whatever you are doing
    exit_mystuff:
    on error resume next
    wkbXL.close
    appXL.quit
    Set wksXL = Nothing
    Set wkbXL = Nothing
    Set appXL = Nothing
    exit sub
    err_mystuff:
    msgbox "sorry - i forgot to implement error handling"
    resume exit_mystuff

    izy
    currently using SS 2008R2

  5. #5
    Join Date
    Nov 2007
    Posts
    93
    thanks for the response .. i did fix that ...

    bt my concern is with the loop now ... its taking each value of i and comparing with all values of j

    because of these line of code
    next j
    next i

    bt i am looking something like

    for each i ..something that kinda code...

    waiting for ur valuable suggestions

  6. #6
    Join Date
    Apr 2004
    Location
    Derbyshire, UK
    Posts
    789
    Provided Answers: 1
    Quote Originally Posted by sam_01
    thanks for the response .. i did fix that ...

    bt my concern is with the loop now ... its taking each value of i and comparing with all values of j

    because of these line of code
    next j
    next i

    bt i am looking something like

    for each i ..something that kinda code...

    waiting for ur valuable suggestions
    Hi

    On the basis that you have fixed everything else anb BOTH columns are in the same worksheet (as they seem to be) then try something like this
    Code:
    I_Last_Row_Sheet1 = appXL.Sheets("inventory_all").End(xlUp).Row
    
    
    For i = 2 To I_Last_Row_Sheet1
        Value_Search1 = appXL.Sheets("inventory_all").Cells(i, "G")
        Value_Search1 = UCase(Value_Search1)
        
        Value_Search2 = appXL.Sheets("inventory_all").Cells(i, "H")
        Value_Search2 = UCase(Value_Search2)
        
        
        If (Value_Search1 < Value_Search2) Then
            appXL.Sheets("inventory_all").Cells(i, "H").Font.ColorIndex = 3
        End If
        
    Next i
    ??

    MTB

  7. #7
    Join Date
    Dec 2002
    Location
    Préverenges, Switzerland
    Posts
    3,740
    nobody else?
    ok - i'll carry on with my criticisms:

    "generally approved style" is to put all the declarations up at the top of the procedure (i don't think it makes any real difference to code execution, but it does make them easier to find).

    Dim i, J As Integer
    is declaring i as Variant (not integer as you might have hoped)

    meanwhile your loop:
    look at a simplified version of your code.
    Code:
    Private Sub butGo_Click()
        Dim i As Integer
        Dim j As Integer
        For i = 1 To 3
            Debug.Print "i = " & i
            For j = 1 To 3
                Debug.Print "   j = " & j
            Next i 'WRONG
        Next j 
    End Sub
    ...that generates a compile error: invalid next


    a double-loop should look like this:
    Code:
    Private Sub butGo_Click()
        Dim i As Integer
        Dim j As Integer
        For i = 1 To 3
            Debug.Print "i = " & i
            For j = 1 To 3
                Debug.Print "   j = " & j
            Next j
        Next i
    End Sub
    
    i = 1
       j = 1
       j = 2
       j = 3
    i = 2
       j = 1
       j = 2
       j = 3
    i = 3
       j = 1
       j = 2
       j = 3
    ...at least that works but it does not do what you want.

    go back to your first post: compare 2 colums which are adjacent to each other - in other words j=i so you only need a single loop.

    Code:
    For i = 2 To I_Last_Row_Sheet1
    Value_Search1 = appXL.Sheets("inventory_all").Cells(i, "G")
    Value_Search1 = UCase(Value_Search1)
    
    Value_Search2 = appXL.Sheets("inventory_all").Cells(i, "H")
    Value_Search2 = UCase(Value_Search2)
    
    If (Value_Search1 < Value_Search2) Then
    appXL.Sheets("inventory_all").Cells(i, "H").Font.ColorIndex = 3
    End If
    ...does that work? well it works as a loop at least, but are you sure about your .Cells(i, "H") ?
    i'm no expert on XL, but i seem to recall that you can use
    .Cells("A1")
    or
    .Cells(RowNumber, ColumnNumber)
    but i dont believe you can use
    .Cells(RowNumber, "A")

    finally, you could stuff a lot of your code into a single line to end up with a loop looking like this:
    Code:
    For i = 2 To I_Last_Row_Sheet1
       if ucase(appXL.Sheets("inventory_all").Cells(i, 7)) < ucase(appXL.Sheets("inventory_all").Cells(i, 8)) then
          appXL.Sheets("inventory_all").Cells(i, 8).Font.ColorIndex = 3
       End If
    Next
    maybe it even works.

    izy

    LATER: sorry MTB - i forgot to refresh before posting.
    currently using SS 2008R2

  8. #8
    Join Date
    Apr 2004
    Location
    Derbyshire, UK
    Posts
    789
    Provided Answers: 1
    Hi all
    Quote Originally Posted by izyrider
    LATER: sorry MTB - i forgot to refresh before posting.
    izy that is not a problem, its normally me that’s too slow.

    However, I can only agree with every this you have said, this is particularly true of tidying up at the end otherwise you can (will!), when using automation, be left with reference hanging around and locking files etc. (as I relearn this morning).

    I must apologise to sam_01 but I just had to rewrite the way I normally tackle these thing to iron out the bugs (see above). This exercise produced the following code
    Code:
    Option Compare Database
    Option Explicit
    
    Sub Test()
        Dim appXL As Excel.Application
        Dim wksXL As Excel.Worksheet
        Dim I_Last_Row_Sheet1 As Integer
        Dim i As Long
        Dim Value_Search1 As Long
        Dim Value_Search2 As Long
        Const cFileName As String = "C:\Test\inventory_all.xls"
        
        
        If Dir(cFileName) = "" Then
            MsgBox "File '" & cFileName & "' does not exist", vbCritical, "File Exists Check"
            Exit Sub
        End If
        
        Set appXL = CreateObject("Excel.Application")
        
        With appXL
            .Workbooks.Open cFileName
            Set wksXL = .ActiveWorkbook.Sheets("inventory_all")
            
            With wksXL
                .Cells(65536, "G").Select
                I_Last_Row_Sheet1 = appXL.Selection.End(xlUp).Row
                
                For i = 2 To I_Last_Row_Sheet1
                    Value_Search1 = .Cells(i, "G")
                    Value_Search2 = .Cells(i, "H")
                        
                    If CStr(Value_Search1) <> "" And CStr(Value_Search2) <> "" Then
                        If (Value_Search1 < Value_Search2) Then
                           .Cells(i, "H").Font.ColorIndex = 3
                        End If
                    End If
                Next i
                
                .Cells(1, 1).Select
            End With
            
            appXL.ActiveWorkbook.Save
            .Quit
        End With
        Set wksXL = Nothing
        Set appXL = Nothing
    End Sub
    Don't know if that is any use, may it will give you some other ideas, but it made me happy!!

    BTW in 10 year using VBA in Excel/Access I have never see Cells(Row,"A") notation before but it obviously works !? Maybe I will use it if I am certain that the column letter will never change.

    MTB

  9. #9
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Quote Originally Posted by MikeTheBike
    BTW in 10 year using VBA in Excel/Access I have never see Cells(Row,"A") notation before but it obviously works !? Maybe I will use it if I am certain that the column letter will never change.

    MTB
    Ditto - never seen before. After an age of searching (just how did MS manage to screw up post 2000 Office help files so spectacularly?) I eventually got to this:
    Item Property*[Excel 2007 Developer Reference]
    In other words, it is documented.

    NOTE - you end up at Range.Item following the description on from Worksheet.Cells as this evaluates to Range.Item!
    Testimonial:
    pootle flump
    ur codings are working excelent.

  10. #10
    Join Date
    Nov 2007
    Posts
    93
    thank you folks !!

    it really worked out

    appreciate your help !! !

    i can play around with these automations but coming up to loops .. i almost gave up ...

    but i did try a certain trick .. and it was creating a macro in excel and calling it from access...

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •