Code takes action on multiple worksheets

[kodehunt]

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
'
'
'
'
End Sub

[ranman256]

If you move to a sheet to 'fix' did you activeate (or select) it first so XL knows what you are working on?
ws.select

[SamT]

Add or edit as comments indicate

DoCmd.SetWarnings False 'After this line
With xlApp
.DisplayAlerts = False
.ScreenUpdating = False
.AllowEvents = False
End With
'
'the rest of the code
'
With xlApp
.DisplayAlerts = True
.ScreenUpdating = True
.AllowEvents = True
End With
Set xlApp = Nothing
End Sub 'Before this line

[snb]

Why so unnecessarily complicated ?

You can create an Excel file that has links to your Access file.
Those links can be updated anytime.
So after the creation of the file, the only thing you have to do is open the file; no export macro needed.

To create an Excel file containing those links use (after adapting the fullname of the Access file):


Sub M_snb()
c00 = "G:\OF\example.mdb"

For j = 1 To 8
With ThisWorkbook.Sheets.Add
.Name = choose(j, "Capital", "CapitalAD", "Training", "TrainingAD", "Other", "OtherAD", "Marketing", "MarketingAD")

With .QueryTables.Add("ODBC;DSN=MS Access-database;DBQ=" & c00, Range("A1"))
.CommandText = "SELECT * FROM `" & c00 & "`." & Choose(j, "qAppDnyCapital", "qAppProcTraining", "qAppDnyTraining", "qAppProcOther", "qAppDnyOther", "qAppProcMarketing", "qAppDnyMarketing")
.Refresh False
End With
End With
Next
End Sub

[JKwan]

snb:
Wonder how I would use your code with a PARAMETER query? I tried for a while and not having any sucess, thanks.

[Krishna Kumar]

Workbook is not fully qualified.


Set wb = xlApp.Workbooks.Open(FileName)

[kodehunt]

Tried fully qualifying, selecting sheet before code, and adding xlApp code and it still duplicates copy and paste column on every worksheet. As far it being overly complex, I am trying to export multiple queries to one spreadsheet, which works fine. I then need to combine worksheets, and format the data, which creates the issue explained prior. I'm not sure how the linking would solve my problem, but I'm sure I'm missing something. I'm now debating exporting the queries to multiple workbooks, formatting each, then combining. I'm out of other ideas.

I assume that when you tried it with the parameter query it did not prompt you for the parameters? If that's the case, you might try calling a form to capture the parameter data, then just setting your query criteria to the fields on that form. After export, close the form.