sdell

[sdell]

Hi everyone
I am a analyst at a Hospital in Philly. Trying to automate my data pulls in Access and exporting into Excel for distribution.
Not a very savy VBA programmer, so need help and suggestions.
So, this code that follows works fine. It runs a query and exports the data into Excel 2016.
My problem is it does not format the data in Excel. It appears its not saving. I need help in formatting my output. I think i am missing a piece of code. Please help me.
Silvana

Private Sub Command71_Click()
DoCmd.SetWarnings False
Dim myFileName As String
Dim myDate
Dim myDateMM
Dim myDateDD
Dim myDateYY

myDate = Date
myDateMM = Month(Date)
myDateDD = Day(Date)
myDateYY = Year(Date)
myDate2 = myDateMM & "." & myDateDD & "." & Mid(myDateYY, 3, 2)

ptext1 = "Please Enter the VendorName"
myFileName = InputBox(ptext1, "Need Input")
MyfileDir1 = "S:\Silvana\SRs\SR_TEST_" & myFileName & "_" & myDate2 & ".xlsx"
myFileDir2 = "S:\Silvana\SRs\SR_TEST(Pre)_" & myFileName & "_" & myDate2 & ".xlsx"

'-------------------------------- Delete Output Files---------------------------------------------'
Dim aFile As String
aFile = "S:\Silvana\SRs\SR_TEST_" & myFileName & "_" & myDate2 & ".xlsx"
If Len(Dir$(aFile)) > 0 Then
    SetAttr aFile, vbNormal
    Kill aFile
End If
bFile = "S:\Silvana\SRs\SR_TEST(Pre)_" & myFileName & "_" & myDate2 & ".xlsx"
If Len(Dir$(bFile)) > 0 Then
    SetAttr bFile, vbNormal
    Kill bFile
End If
'--------------------------------------------------------------------------------------------------'
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "SR_UpdPrice_ExactActive", "S:\Silvana\SRs\SR_TEST_" & myFileName & "_" & myDate2 & ".xlsx", True, "ExactActive"
Dim appExcel As Object
Dim workBook As Object
Dim workSheet As Object
strTemplatesPath = "S:\Silvana\SRs"
'Set workBook = workBook("S:\Silvana\SRs\SR_TEST_" & myFileName & "_" & myDate2 & ".xlsx")
'-----------------------------------------------------------------------------------------------------------------------------------------------------'
'-----------------------------------------------------------------------------------------------------------------------------------------------------'
strSheet = MyfileDir1
MsgBox "Excel workbook: " & strSheet
' Open an existing spreadsheet
Set appExcel = GetObject(strSheet)
' Show spreadsheet on screen
'appExcel.Application.Visible = True
'appExcel.Parent.Windows(1).Visible = False
' Autofit all columns on a worksheet and apply heading format and autofilter
'Prevent Computer Screen from running
  appExcel.Application.ScreenUpdating = False
'Allow Computer Screen to refresh (not necessary in most cases)
  appExcel.Application.ScreenUpdating = True
  appExcel.Application.DisplayAlerts = True

Set workSheet = appExcel.Worksheets("ExactActive")
workSheet.Range("A1:AX65000").Font.Size = 7.5

workSheet.Range("A1:B1").Interior.ColorIndex = 22
workSheet.Range("A2:B65000").Interior.ColorIndex = 22
workSheet.Range("C1:M1").Interior.ColorIndex = 4
workSheet.Range("C2:M65000").Interior.ColorIndex = 19
workSheet.Range("N1:T1").Interior.ColorIndex = 37
workSheet.Range("N2:T65000").Interior.ColorIndex = 20
workSheet.Range("U1:AB1").Interior.ColorIndex = 39
workSheet.Range("U2:AB65000").Interior.ColorIndex = 24

workSheet.Range("AC1:AD1").Interior.ColorIndex = 43
workSheet.Range("AC2:AD65000").Interior.ColorIndex = 35
workSheet.Range("AE1:AF1").Interior.ColorIndex = 4
workSheet.Range("AE2:AF65000").Interior.ColorIndex = 19
workSheet.Range("AG1:AJ1").Interior.ColorIndex = 43
workSheet.Range("AG2:AJ65000").Interior.ColorIndex = 35
workSheet.Range("AK1:AL1").Interior.ColorIndex = 39
workSheet.Range("AK2:AL65000").Interior.ColorIndex = 24
workSheet.Range("AM1:AM1").Interior.ColorIndex = 4
workSheet.Range("AM2:AM65000").Interior.ColorIndex = 19

workSheet.Cells.EntireColumn.AutoFit
With workSheet
workSheet.Range("A1:AM65000").Font.Size = 7#

workSheet.Range("C1:C65000").ColumnWidth = 18 'PSNo'
workSheet.Range("D1:D65000").ColumnWidth = 20 'VndrItmID'
workSheet.Range("E1:E65000").ColumnWidth = 3  'UOM'
workSheet.Range("F1:F65000").ColumnWidth = 12 'NewPrice'
workSheet.Range("G1:G65000").ColumnWidth = 10 'VendorNo'
workSheet.Range("H1:H65000").ColumnWidth = 15 'VendorName'
workSheet.Range("I1:I65000").ColumnWidth = 5  'Location'
workSheet.Range("J1:J65000").ColumnWidth = 5  'Dflt UOM'

workSheet.Range("K1:K65000").ColumnWidth = 10 'Diff'
workSheet.Range("L1:L65000").ColumnWidth = 7  'UOMFlg'
workSheet.Range("M1:M65000").ColumnWidth = 7  'CnvFlg'

workSheet.Range("N1:N65000").ColumnWidth = 5  'IM-->'
workSheet.Range("O1:R65000").ColumnWidth = 7 'IMaster data'
workSheet.Range("S1:T65000").ColumnWidth = 10 'IMaster data'
workSheet.Range("U1:AB65000").ColumnWidth = 10 'IMaster data'

workSheet.Range("AC1:AH65000").ColumnWidth = 10 'IMaster data'
workSheet.Range("AE1:AF65000").ColumnWidth = 9  'IMaster data'
workSheet.Range("AI1:AJ65000").ColumnWidth = 30  'IMaster data'

With xlsheet1
    workSheet.Range("C1:G65000").Font.Bold = True
    workSheet.Range("C2:G65000").Font.ColorIndex = 51 'deep green'
  
    workSheet.Range("K1:M65000").Font.Bold = True
    workSheet.Range("K1:M65000").Font.ColorIndex = 3
    workSheet.Range("K1:M65000").Font.Size = 8#

    workSheet.Range("N1:N65000").Font.Bold = True
    workSheet.Range("P1:T65000").Font.Size = 8#
    workSheet.Range("P1:T65000").Font.Bold = True
    workSheet.Range("P2:T65000").Font.ColorIndex = 53

    workSheet.Range("U1:AB65000").Font.Size = 8.5
    workSheet.Range("U1:AB65000").Font.Bold = True
    workSheet.Range("U2:AB65000").Font.ColorIndex = 53
  
    workSheet.Range("AE1:AF65000").Font.Size = 8#
    workSheet.Range("AE1:AF65000").Font.Bold = True
    workSheet.Range("AE2:AF65000").Font.ColorIndex = 53
  
    workSheet.Range("AM1:AM65000").Font.Size = 8#
    workSheet.Range("AM1:AM65000").Font.Bold = True
    workSheet.Range("AM2:AM65000").Font.ColorIndex = 53
End With
End With
With workSheet
.Range("A1:AP1").AutoFilter
End With

'------------------ Remove Blank Rows --------------------------------------------------'
With workSheet
    .Range("A1:AP65000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42), Header:=xlYes
End With

Set dbs = Nothing
MsgBox "Done"
End Sub

EDIT by Isladogs - added code tags to improve readability

 

[theDBguy]

Hi Silvana. Welcome to AWF! I already responded in your other thread.

 

[The_Doc_Man]

Hello and welcome, Silvana.

Do not be surprised if a moderator moves this post, because the "Introduction" area is normally not used for technical issues. Also, it is common when posting code sequences to post code tags around them. But you are new here and would not have known either of those things. Therefore, don't take my comments as a slap but as a gentle comment to inform you of site protocols.

 

[pbaldy]

Do not be surprised if a moderator moves this post

So moved. Welcome Silvana!