sdell (1 Viewer)

sdell

New member
Local time
Today, 10:15
Joined
Mar 6, 2020
Messages
4
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

Code:
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
 
Last edited by a moderator:

theDBguy

I’m here to help
Staff member
Local time
Today, 07:15
Joined
Oct 29, 2018
Messages
21,358
Hi Silvana. Welcome to AWF! I already responded in your other thread.
 

The_Doc_Man

Immoderate Moderator
Staff member
Local time
Today, 09:15
Joined
Feb 28, 2001
Messages
27,003
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.
 

Users who are viewing this thread

Top Bottom