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

    Unanswered: automation of excel from access

    i am trying to do few things through automation and i am struct here ..
    i am comparing 2 sheets of same workbook from access

    the code is :

    path = MakeFileName()
    On Error GoTo Err_Handler

    Dim strSQL As String
    Dim appXL As Excel.Application
    Dim wkbXL As Excel.workBook
    Dim wksXL As Excel.workSheet

    Set wkbXL = GetObject(path)
    Set appXL = wkbXL.Parent
    Set wksXL = wkbXL.Worksheets("version")

    appXL.Visible = False
    wkbXL.Windows(1).Visible = True
    With wksXL

    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("version").range("A65536").end(xlUp). Row
    I_Last_Row_Sheet2 = appXL.Sheets("version").range("A65536").end(xlUp). Row
    '
    For i = 2 To I_Last_Row_Sheet1
    Value_Search1 = appXL.Sheets("version").Cells(i, "A") &appXL.Sheets("version").Cells(i, "B") & appXL.Sheets("version").Cells(i, "C")
    Value_Search1 = UCase(Value_Search1)
    For J = 2 To I_Last_Row_Sheet2
    Value_Search2 = appXL.Sheets("table").Cells(J, "A") & appXL.Sheets("table").Cells(J, "B") & appXL.Sheets("table").Cells(J, "C")
    Value_Search2 = UCase(Value_Search2)
    If (Value_Search1 = Value_Search2) Then
    Header =appXL.Sheets("table").Cells(J, "D")
    For Each c In [D1:AE1]
    If c.Value Like Header Then
    With Cells(i, c.Column).Interior
    .ColorIndex = 35
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    End With
    With Cells(i, c.Column).borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Cells(i, c.Column).borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Cells(i, c.Column).borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Cells(i, c.Column).borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    End If
    Next
    End If
    Next J
    Next i

    End With


    'appXL.SaveWorkspace
    wkbXL.Save
    appXL.Quit
    Set objXLRange = Nothing
    Set wksPivot = Nothing
    Set wksXL = Nothing
    Set wkbXL = Nothing
    Set appXL = Nothing


    Err_Handler:


    WHEN I RUN this code its taking foreever . .dont know why and there is no output or any error

    any thoughts would be appreciated..
    thanks

  2. #2
    Join Date
    Apr 2004
    Location
    Kingsland, Georgia
    Posts
    231
    Just a quick question: Have you tried setting breakpoints and watches and debugging it once through to make sure the values you're getting for all the variables (i.e. I_Last_Row_Sheet1, Value_Search1) are what you're expecting? I didn't notice any glaring errors with the code, but I've been at work for 9 hours today, so I can't guarantee anything.

  3. #3
    Join Date
    Nov 2007
    Posts
    93

    automation of excel from access

    thanks for the response

    i have solved the problem and it was due to . .access doesnt know which cell refernces like excel vba

    so here is the working code for future turns:


    'On Error GoTo Err_Handler

    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("version")

    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("version").range("A65536").end(xlUp). Row
    I_Last_Row_Sheet2 = appXL.Sheets("version").range("A65536").end(xlUp). Row
    '
    For i = 2 To I_Last_Row_Sheet1
    Value_Search1 = appXL.Sheets("version").Cells(i, "A") & appXL.Sheets("version").Cells(i, "B") & appXL.Sheets("version").Cells(i, "C")
    Value_Search1 = UCase(Value_Search1)
    For J = 2 To I_Last_Row_Sheet2
    Value_Search2 = appXL.Sheets("table").Cells(J, "A") & appXL.Sheets("table").Cells(J, "B") & appXL.Sheets("table").Cells(J, "C")
    Value_Search2 = UCase(Value_Search2)
    If (Value_Search1 = Value_Search2) Then
    Header = appXL.Sheets("table").Cells(J, "D")
    For Each c In appXL.Sheets("version").range("D1:AE1")
    If c.Value Like Header Then
    With appXL.Sheets("version").Cells(i, c.Column).Interior
    .ColorIndex = 35
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    End With
    With appXL.Sheets("version").Cells(i, c.Column).borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With appXL.Sheets("version").Cells(i, c.Column).borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With appXL.Sheets("version").Cells(i, c.Column).borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With appXL.Sheets("version").Cells(i, c.Column).borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    End If
    Next
    End If
    Next J
    Next i

    End With

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

    Err_Handler:
    End Sub

Posting Permissions

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