none
VBA code executes accross multiple worksheets. RRS feed

  • Question

  • 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 (as in the code example) and fully qualified, with the same results.  What's weird is not all the cole runs on all worksheets, just some.  Below is the code, the red code 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:D,K:K,M:M").Delete
            ADws.Range("A:B,D: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
    Friday, October 17, 2014 5:33 PM

Answers

  • 1) Possibly, you have event code that is being fired by your changes. What happens if you use 

    Application.EnableEvents = False

    as the first line of your code, and finish with

    Application.EnableEvents = True

    2) Your workbook is corrupt, and needs to be re-built from a fresh workbook.

    Friday, October 17, 2014 6:55 PM