Results 1 to 2 of 2
  1. #1
    Join Date
    Dec 2003
    Posts
    7

    Unanswered: Code takes action on multiple worksheets

    I am exporting several queries to one Excel workbook with mulitple worksheets (1 worksheet for each query). I then need to run some cleanup code on the workbook. Unfortunately some of my code runs agains all worksheets even though (I think) I have directly identified which worksheet to perform the code on. I have identified the worksheet via variables (an in the code example) for fully qualified, with the same results. What's weird is not all the cole runs on all worksheets, just some. Below is the code, I put arrows in front of the code that duplicates accross all worksheets. Any help is much appreciated.

    Private Sub butExtract_Click()

    Dim fDialog As FileDialog
    Dim FileName As Variant
    Dim xlApp As Object
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim ADws As Worksheet
    Dim LastRow As Long
    Dim ADLastRow As Long

    Set xlApp = CreateObject("Excel.Application")
    FileName = ""

    DoCmd.SetWarnings False
    xlApp.DisplayAlerts = False

    Set fDialog = Application.FileDialog(msoFileDialogSaveAs)

    With fDialog

    .Title = "Where would you like to extract Budget items to?"
    .AllowMultiSelect = False
    .initialfilename = "Budget.xlsx"
    If .show = True Then
    FileName = fDialog.SelectedItems(1)
    If Len(Dir$(FileName)) > 0 Then
    SetAttr FileName, vbNormal
    Kill FileName
    End If
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qAppProcCapital", FileName, True, "Capital"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qAppDnyCapital", FileName, True, "CapitalAD"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qAppProcTraining", FileName, True, "Training"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qAppDnyTraining", FileName, True, "TrainingAD"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qAppProcOther", FileName, True, "Other"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qAppDnyOther", FileName, True, "OtherAD"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qAppProcMarketing", FileName, True, "Marketing"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qAppDnyMarketing", FileName, True, "MarketingAD"
    End If

    End With

    Set wb = Workbooks.Open(FileName)
    Set ws = wb.Sheets("Capital")
    Set ADws = wb.Sheets("CapitalAD")

    With ws
    .Range("A:B,D,K:K,M:M").Delete
    ADws.Range("A:B,D,K:K").Delete

    LastRow = .UsedRange.Rows.Count
    ADLastRow = ADws.UsedRange.Rows.Count

    If ADLastRow > 1 Then
    ADws.Range("A2:I" & ADLastRow).Copy
    .Cells("A" & LastRow + 1).PasteSpecial
    End If

    LastRow = .UsedRange.Rows.Count

    .Range("A1").Value = "Requester"

    --> .Columns("F:F").Insert shift:=xlToRight
    --> .Range("F1").Value = "Total"
    --> .Range("F2").Formula = "=RC[-2]*RC[-1]"

    --> .Columns("I:I").Insert shift:=xlToRight
    --> .Range("I1").Value = "Status"
    --> .Range("I2").Formula = "=IF(RC[-1]=0,""Approved"",IF(RC[-1]=1,""Denied"",""Processing""))"

    .Range("K1").Value = "Last/Pending Approver"

    If LastRow > 2 Then
    .Range("F2").AutoFill Destination:=Range("F2:F" & LastRow)
    .Range("I2").AutoFill Destination:=Range("I2:I" & LastRow)
    End If

    wb.Sheets("Capital").Columns("I:I").Copy
    wb.Sheets("Capital").Columns("H:H").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipblanks:=False, Transpose:=False
    wb.Sheets("Capital").Columns("I:I").Delete

    ADws.Delete

    End With

  2. #2
    Join Date
    Jan 2002
    Location
    Bay Area
    Posts
    511
    Try this--after "With ws", add ".Activate" and see if that makes a difference.
    Just a hunch.
    Good luck.

Posting Permissions

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