VBA Excel 2010 Hide Non Adjacent Columns not working

C

captdkl02

Registered User.
Local time
Today, 14:05
Joined
Dec 4, 2012
Messages
21
I am formatting access data to excel worksheet and the portion of my code runs, but it is not hiding excel columns that I specify.

I am including the function below and highlighted code hiding the excel columns portion that does not hide the columns. I took the code generated by Excel when recording macro while performing this manually within excel.

Here is the function below. The hiding excel columns code is towards the bottom of the function higlighted in "red". Btw, I am generating multiple Excel workbooks with multiple tabs (sheets), so doing this manually is out of the question.

Any help is greatly appreciated.

Thank you.

David

Code: 
Public Function SendTQ2XLWbSheet(strTQName As String, strSheetName As String, strFilePath As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
 
' strFilePath is the name and path of the file you want to send this data into.
 
Dim rst As DAO.Recordset
Dim Apxl As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.field
Dim FileExists As Boolean
Dim strPath As String
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
' On Error GoTo err_handler
 
FileExists = False
strPath = strFilePath
 
Set rst = CurrentDb.OpenRecordset(strTQName)
 
Set Apxl = CreateObject("Excel.Application")
 
' Check if Excel Workbook exists
If Not WorkBookExists(strPath) Then
' MsgBox "Excel Workbook doesn't exist and creating one!"
Set xlWBk = Apxl.Workbooks.Add
FileExists = False
 
' Check if Excel Worksheet name exists
If Not SheetExists(strSheetName, xlWBk) Then
' MsgBox "Excel Worksheet doesn't exist and creating one!"
Set xlWSh = xlWBk.Worksheets.Add
xlWSh.Name = strSheetName
' xlWBk.SaveAs strPath
' xlWBk.Worksheets.Add().Name = strSheetName
' Set xlWSh = xlWBk.Worksheets(strSheetName)
' xlWbk.Worksheets(strSheetName).Activate
Else
Set xlWSh = xlWBk.Worksheets(strSheetName)
' xlWSh.Activate
End If ' end to Check for Excel Worksheet
 
' When Workbook already exists setting workbook and worksheet
Else
Set xlWBk = Apxl.Workbooks.Open(strPath)
' Check if Excel Worksheet name exists
If Not SheetExists(strSheetName, xlWBk) Then
' MsgBox "Excel Worksheet doesn't exist and creating one!"
Set xlWSh = xlWBk.Worksheets.Add
xlWSh.Name = strSheetName
' xlWBk.Worksheets.Add().Name = strSheetName
' Set xlWSh = xlWBk.Worksheets(strSheetName)
' xlWbk.Worksheets(strSheetName).Activate
Else
Set xlWSh = xlWBk.Worksheets(strSheetName)
' xlWSh.Activate
End If ' end to Check for Excel Worksheet
' Set xlWSh = xlWBk.Worksheets(strSheetName)
FileExists = True
' xlWSh.Activate
End If ' end to Check for Excel Workbook
Apxl.Visible = False
xlWSh.Activate
 
 
rst.MoveFirst
'Get column headers
Dim i As Integer
Dim field As String
Dim rst2 As DAO.Recordset
Set rst2 = CurrentDb.OpenRecordset(strTQName)
With rst2
For i = 1 To .fields.Count
xlWSh.Cells(1, i) = .fields(i - 1).Name
Next i
End With
 
Set rst2 = Nothing
 
xlWSh.Range("A2").CopyFromRecordset rst
 
' end Get column headers
' LastRow = ActiveSheet.UsedRange.Rows.Count
 
' FORMAT SPEND PLAN WORKBOOK
'
' FormatAllData Macro
'
Dim LR As Integer
Dim Rng As String
 
' LR = ApXL.ActiveCell.SpecialCells(xlCellTypeLastCell).Row
' MsgBox ApXL.ActiveCell.SpecialCells(xlCellTypeLastCell).Row
' MsgBox ActiveSheet.UsedRange.Select
' MsgBox ActiveCell.CurrentRegion.Select
LR = xlWSh.Range("A:A").Find("*", xlWSh.Range("A1"), SearchDirection:=xlPrevious).Row
'MsgBox xlWSh.Range("A:A").Find("*", xlWSh.Range("A1"), SearchDirection:=xlPrevious).Row
 
Rng = "A1:BP" & CStr(LR)
' MsgBox Rng
xlWSh.Range(Rng).Select
With Apxl.Selection.Font
.Name = "Arial"
.Bold = False
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Apxl.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Apxl.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Apxl.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Apxl.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Apxl.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Apxl.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Apxl.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Apxl.Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
xlWSh.Rows("1:1").Select
Apxl.Selection.Font.Bold = True
With Apxl.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Apxl.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
 
'
' YellowHeader Macro
'
xlWSh.Range("C1:F1").Select
With Apxl.Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 13434879
.TintAndShade = 0
.PatternTintAndShade = 0
End With
xlWSh.Range("N1:AW1").Select
With Apxl.Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 13434879
.TintAndShade = 0
.PatternTintAndShade = 0
End With
 
'
' ObjectClass Macro
'
' Calculate range
Rng = "B1:B" & CStr(LR)
 
xlWSh.Range(Rng).Select
With Apxl.Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -4.99893185216834E-02
.PatternTintAndShade = 0
End With
 
' Calculate range
Rng = "B2:B" & CStr(LR)
 
xlWSh.Range(Rng).Select
With Apxl.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
xlWSh.Range("B1").Select
With Apxl.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
 
'
' MissionCritical Macro
'
' Calculate range
Rng = "G1:G" & CStr(LR)
 
xlWSh.Range(Rng).Select
With Apxl.Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
With Apxl.Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
 
'
' VendorGreen Macro
'
' Calculate range
Rng = "H1:M" & CStr(LR)
 
xlWSh.Range(Rng).Select
With Apxl.Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
With Apxl.Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
xlWSh.Range("H1").Select
xlWSh.Columns("J:J").ColumnWidth = 11.71
xlWSh.Columns("L:L").ColumnWidth = 9.29
 
'
' CapitalYellow Macro
'
' Calculate range
Rng = "M1:M" & CStr(LR)
 
xlWSh.Range(Rng).Select
With Apxl.Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
xlWSh.Columns("M:M").ColumnWidth = 9.43
 
'
' TotalSpend Macro
'
' Calculate range
Rng = "AX1:AX" & CStr(LR)
 
xlWSh.Range(Rng).Select
With Apxl.Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Apxl.Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
xlWSh.Columns("AX:AX").ColumnWidth = 16.71
xlWSh.Columns("AX:AX").Select
With Apxl.Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Apxl.Selection.ColumnWidth = 13.29
xlWSh.Range("AX1").Select
With Apxl.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
 
'
' FY12EOY Macro
'
' Calculate range
Rng = "AY1:AY" & CStr(LR)
 
xlWSh.Range(Rng).Select
With Apxl.Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
xlWSh.Range("AY1").Select
With Apxl.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
 
'
' QTRAUTH Macro
'
' Calculate range
Rng = "BA1:BA" & CStr(LR)
Rng = Rng & ",BD1:BD" & CStr(LR)
Rng = Rng & ",BG1:BG" & CStr(LR)
Rng = Rng & ",BJ1:BJ" & CStr(LR)
Rng = Rng & ",BM1:BM" & CStr(LR)
 
xlWSh.Range(Rng).Select
' Calculate range
Rng = "BA" & CStr(LR)
 
xlWSh.Range(Rng).Activate
With Apxl.Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
' Calculate range
Rng = "BM1:BM" & CStr(LR)
 
xlWSh.Range(Rng).Select
With Apxl.Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
 
'
' QTRPLAN Macro
'
 
xlWSh.Range("AZ1,BC1,BF1,BI1,BL1").Select
xlWSh.Range("BL1").Activate
With Apxl.Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 52479
.TintAndShade = 0
.PatternTintAndShade = 0
End With
' Calculate range
Rng = "AZ2:AZ" & CStr(LR)
Rng = Rng & ",BC2:BC" & CStr(LR)
Rng = Rng & ",BF2:BF" & CStr(LR)
Rng = Rng & ",BI2:BI" & CStr(LR)
Rng = Rng & ",BL2:BL" & CStr(LR)
 
xlWSh.Range(Rng).Select
' Calculate range
Rng = "BL" & CStr(LR)
 
xlWSh.Range(Rng).Activate
With Apxl.Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
xlWSh.Range("BL1").Select
With Apxl.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
 
'
' TABDIV Macro
'
' Calculate range
Rng = "BO2:BP" & CStr(LR)
xlWSh.Range(Rng).Select
With Apxl.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
 
'
' RecordInfo Macro
'
'
xlWSh.Columns("C:C").ColumnWidth = 15.14
xlWSh.Columns("C:C").Select
With Apxl.Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
xlWSh.Range("D1").Select
xlWSh.Columns("D:D").ColumnWidth = 19.86
xlWSh.Columns("D:D").Select
With Apxl.Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
xlWSh.Range("E1").Select
xlWSh.Columns("E:E").ColumnWidth = 25.71
xlWSh.Columns("E:E").Select
With Apxl.Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
xlWSh.Columns("F:F").Select
Apxl.Selection.ColumnWidth = 22.71
xlWSh.Columns("F:F").Select
With Apxl.Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
 
'
' ReqNum Macro
'
'
xlWSh.Columns("A:A").ColumnWidth = 14.71
' Calculate range
Rng = "A1:A" & CStr(LR)
 
xlWSh.Range(Rng).Select
With Apxl.Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
 
'
' Qtr Actual
'
' Calculate range
Rng = "BB1:BB" & CStr(LR)
Rng = Rng & ",BE1:BE" & CStr(LR)
Rng = Rng & ",BH1:BH" & CStr(LR)
Rng = Rng & ",BK1:BK" & CStr(LR)
Rng = Rng & ",BN1:BN" & CStr(LR)
 
xlWSh.Range(Rng).Select
With Apxl.Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16737996
.TintAndShade = 0
.PatternTintAndShade = 0
End With
 
'
' ColumnFormat Macro
'
'
xlWSh.Columns("B:B").Select
Apxl.Selection.ColumnWidth = 8.43
With Apxl.Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Apxl.Selection.ColumnWidth = 7.57
Apxl.Selection.ColumnWidth = 6.86
xlWSh.Columns("G:G").Select
With Apxl.Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
xlWSh.Columns("AY:AY").Select
With Apxl.Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Apxl.Selection.ColumnWidth = 11.43
xlWSh.Columns("AJ:AJ").Select
With Apxl.Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Apxl.Selection.ColumnWidth = 11.14
xlWSh.Columns("AX:AX").Select
With Apxl.Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Apxl.Selection.ColumnWidth = 13
 
'
' Dollars Macro
'
' Calculate range
Rng = "N2:BN" & CStr(LR)
 
xlWSh.Range(Rng).Select
Apxl.Selection.NumberFormat = "$#,##0.00"
 
'
[COLOR=#ff0000]' Hide Columns[/COLOR]
'
'
' xlWSh.Columns("Oct Auth", "Oct Actual", "Nov Auth", "Nov Plan").Select
' Apxl.Selection.EntireColumn.Hidden = True
' Columns("Y:Z").Select
' Selection.EntireColumn.Hidden = True
' xlWSh.Range( _
' "O:O,O:O,P:P,R:R,S:S,U:U,V:V,X:X,Y:Y,AA:AA,AB:AB,AD:AD,AE:AE,AG:AG,AH:AH,AJ:AJ,AK:AK,AM:AM,AN:AN,AP:AP,AQ:AQ,AS:AS,AT:AT,AV:AV,AW:AW,AZ:AZ,BB:BB,BC:BC" _
' ).Select
' xlWSh.Columns("O:P").Select
' xlWSh.Range("P1").Activate
' Apxl.Selection.EntireColumn.Hidden = True
[COLOR=#ff0000]Apxl.Union(xlWSh.Range( _[/COLOR]
[COLOR=#ff0000]"BJ:BJ,BL:BL,BM:BM,BO:BO,BP:BP,BX:BX,BY:BY,CE:CE,CD:CD,CC:CC,CB:CB,CA:CA,BZ:BZ,O:O,O:O,P:P,R:R,S:S,U:U,V:V,X:X,Y:Y,AA:AA,AB:AB,AD:AD,AE:AE,AG:AG,AH:AH,AJ:AJ,AK:AK,AM:AM,AN:AN" _[/COLOR]
[COLOR=#ff0000]), xlWSh.Range( _[/COLOR]
[COLOR=#ff0000]"AP:AP,AQ:AQ,AS:AS,AT:AT,AV:AV,AW:AW,AZ:AZ,BB:BB,BC:BC,BD:BD,BF:BF,BG:BG,BI:BI" _[/COLOR]
[COLOR=#ff0000])).Select[/COLOR]
[COLOR=#ff0000]xlWSh.Range("BZ1").Activate[/COLOR]
[COLOR=#ff0000]Apxl.Selection.EntireColumn.Hidden = True[/COLOR]
 
 
'
' UnHide Columns
'
'
' Columns("C:F").Select
' Selection.EntireColumn.Hidden = False
 
'
' DarkUnderline Macro
'
' Calculate range
Rng = "A1:BP" & CStr(LR)
 
xlWSh.Range(Rng).Select
Apxl.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Apxl.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Apxl.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Apxl.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Apxl.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Apxl.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Apxl.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Apxl.Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
' Calculate range
Rng = "A2:BP" & CStr(LR)
 
xlWSh.Range(Rng).Select
Apxl.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Apxl.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Apxl.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Apxl.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Apxl.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Apxl.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Apxl.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Apxl.Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
 
' Call Function to delete sheet 1, 2, & 3 tabs
Call DeleteTabs(Apxl, xlWBk)
 
 
' selects all of the cells
Apxl.ActiveSheet.Cells.Select
 
' does the "autofit" for all columns
Apxl.ActiveSheet.Cells.EntireColumn.AutoFit
 
'
' Select cells to protect ... specifically the calculated fields
'
' Calculate range
Rng = "A1:BP1, A2:A" & CStr(LR) & " , AX2:BN" & CStr(LR)
 
xlWSh.Cells.Locked = False
xlWSh.Range(Rng).Locked = True
Apxl.ActiveSheet.Protect Password:="Password"
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select
'Save the Workbook and Quit Excel
If FileExists Then
xlWBk.Close savechanges:=True
Else
xlWBk.SaveAs strPath
End If ' ending checking for saving workbook
 
rst.Close
 
Apxl.Quit
Set xlWSh = Nothing
Set xlWBk = Nothing
Set Apxl = Nothing
Set rst = Nothing
' Application.Quit this kills excel and access the same time... not good
Exit_SendTQ2XLWbSheet:
Exit Function
 
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_SendTQ2XLWbSheet
End Function
 
Last edited:
Please use code tags around your code. The cut/paste can generate funny characters, I will be able to help you with the code better.
If you don't see the code tags on top of your Advanced menu - go back to your post and edit it - then put
Code: 
 your code after this   and
at the end of the code.
the above code window has the square brackets aroung the word CODE at the beginning and square brackets around the word /CODE at the end of the code
Non contigous Column hide:
I use Objxl as my Excel object. Once your workbook is active you can use:
objxl.Range("Q:S,V:X,AA:AC").Select
objxl.Range("AA1").Activate
objxl.Selection.EntireColumn.Hidden = True

Are you asking about the Worksheets collection?
The worksheets collection can be put into a loop so the same function can be run on each of them. Or, if it applies to all worksheets - look at the For Each statement.
 
I put tags around the code.

Also, I tried a simplistic code that did not hide columns.

I tried these code fragments and did not work either.

Code: 
Apxl.Union(xlWSh.Range( _
        "BJ:BJ,BL:BL,BM:BM,BO:BO,BP:BP,BX:BX,BY:BY,CE:CE,CD:CD,CC:CC,CB:CB,CA:CA,BZ:BZ,O:O,O:O,P:P,R:R,S:S,U:U,V:V,X:X,Y:Y,AA:AA,AB:AB,AD:AD,AE:AE,AG:AG,AH:AH,AJ:AJ,AK:AK,AM:AM,AN:AN" _
        ), xlWSh.Range( _
        "AP:AP,AQ:AQ,AS:AS,AT:AT,AV:AV,AW:AW,AZ:AZ,BB:BB,BC:BC,BD:BD,BF:BF,BG:BG,BI:BI" _
        )).Select
    xlWSh.Range("BZ1").Activate
    Apxl.Selection.EntireColumn.Hidden = True
    xlWSh.Range("BJ:BJ,BL:BL,BM:BM,BO:BO,BP:BP,BX:BX,BY:BY,CE:CE,CD:CD,CC:CC,CB:CB,CA:CA,BZ:BZ,O:O,O:O,P:P,R:R,S:S,U:U,V:V,X:X,Y:Y,AA:AA,AB:AB,AD:AD,AE:AE,AG:AG,AH:AH,AJ:AJ,AK:AK,AM:AM,AN:AN").EntireColumn.Hidden = True
 
Thanks for the code tags - it is much less worse LOL
You are trying to union some columns in the worksheet to hide?
The Excel Application has the current worksheet as the default.


APxl.Sheets("Sheet1").Select
Apxl.Range("BJ:BJ,BL:BL,BM:BM,BO:BO,BP:BP,BX:BX,BY:BY,CE:CE").Select
Apxl.Range("CE1").Activate
Apxl.Selection.EntireColumn.Hidden = True

dim Mycounter as integer
for Mycounter = 1 to 3
APxl.Sheets(Mycounter).Select
Apxl.Range("BJ:BJ,BL:BL,BM:BM,BO:BO,BP:BP,BX:BX,BY:BY,CE:CE").Select
Apxl.Range("CE1").Activate
Apxl.Selection.EntireColumn.Hidden = True
next Mycounter

Didn't put all of your columns in there.
Suggest you break up your columns into groups, not do all of them at once

Then put a "break point" at the Select statement
In your code window, set the Immediate Window visible
When you hit your break point - in the Immediate window type
Apxl.Visible = True
Your hidden Excel workbook with show now. Then step through the code one line at a time. Start with hiding one column, then move the execution pointer back and run the same lines again.
 
Rx,

I used your code fragement in my function and did not hide the columns while running VB script with Access. However, I took this code and ran as macro within the Excel sheet while excel was open and it worked.

Code: 
    Range("BJ:BJ,BL:BL,BM:BM,BO:BO,BP:BP,BX:BX,BY:BY,CE:CE").Select
    Range("CE1").Activate
    Selection.EntireColumn.Hidden = True

Any thoughts??

Thank you.
 
Stripped out the recordset and most formatting to get to the point of hiding the columns for you. This is hardcoded to save to a network drive, you can alter it yourself.

This will do just enough to show you that the Excel is created (gave you an improved method there too) alters the worksheet, hides the column, saves as and closes.

Hope that helps.

Code: 
Option Compare Database
Option Explicit
Sub TEST_Excel()
      Dim rst As DAO.Recordset
      Dim Apxl As Object
      Dim xlWBk As Object
      Dim xlWSh As Object
      Dim fld As DAO.field
      Dim FileExists As Boolean
      Dim strPath As String
      Dim strFilePath As String
      Dim strSheetName As String
      Const xlCenter As Long = -4108
      Const xlBottom As Long = -4107
      ' On Error GoTo err_handler
10    strSheetName = "AATESTExcel"
20    strPath = "M:\"
30    FileExists = False
       
      'Set rst = CurrentDb.OpenRecordset(strTQName)
       ' Suggest putting some kind of check here to see it is successful
                                              'Set Apxl = CreateObject("Excel.Application")
40    Set Apxl = New Excel.Application
50    Apxl.Visible = True  ' change to false after testing
      ' Check if Excel Workbook exists
      'If Not WorkBookExists(strPath) Then
      ' MsgBox "Excel Workbook doesn't exist and creating one!"
60    Set xlWBk = Apxl.Workbooks.Add
70    Set xlWSh = xlWBk.Worksheets(1) ' your worksheets probably have a default of 3 or more automatically there
      ' the 1 (first worksheet) can be substituted with a variable e.g. Worksheet(WorkSheetNumber) to use in a loop later
80    xlWSh.Name = strSheetName
90    Set xlWSh = xlWBk.Worksheets(strSheetName)
100   Apxl.ActiveWorkbook.SaveAs FileName:=strPath & "Testing" & Second(Now()) & ".xlsx"
      'xlWSh.Name = strSheetName
      'Set xlWSh = xlWBk.Worksheets(strSheetName)
      'Apxl.Visible = True
110   xlWSh.Activate
       
      Dim LR As Integer
      Dim Rng As String
       
120   xlWSh.Range("H1").Select
130   xlWSh.Columns("J:J").ColumnWidth = 11.71
140   xlWSh.Columns("L:L").ColumnWidth = 9.29
       
150   xlWSh.Range("AZ1,BC1,BF1,BI1,BL1").Select
160   xlWSh.Range("BL1").Activate
170   With Apxl.Selection.Interior
180   .PatternColorIndex = xlAutomatic
190   .Color = 52479
200   .TintAndShade = 0
210   .PatternTintAndShade = 0
220   End With
       
230   xlWSh.Range("BL1").Select
       
240   xlWSh.Columns("C:C").ColumnWidth = 15.14
250   xlWSh.Columns("C:C").Select
260   xlWSh.Range("D1").Select
270   xlWSh.Columns("D:D").ColumnWidth = 19.86
280   xlWSh.Columns("D:D").Select
290   xlWSh.Range("E1").Select
300   xlWSh.Columns("E:E").ColumnWidth = 25.71
310   xlWSh.Columns("E:E").Select
320    xlWSh.Columns("B:B").Select
330   Apxl.Selection.ColumnWidth = 8.43
340   Apxl.Selection.ColumnWidth = 7.57
350   Apxl.Selection.ColumnWidth = 6.86
360   xlWSh.Columns("G:G").Select
370   Apxl.Selection.ColumnWidth = 11.43
380   Apxl.Selection.ColumnWidth = 13
       
      'Apxl.Union(xlWSh.Range( _
      "BJ:BJ,BL:BL,BM:BM,BO:BO,BP:BP,BX:BX,BY:BY,CE:CE,CD:CD,CC:CC,CB:CB,CA:CA,BZ:BZ,O:O,O:O,P:P,R:R,S:S,U:U,V:V,X:X,Y:Y,AA:AA,AB:AB,AD:AD,AE:AE,AG:AG,AH:AH,AJ:AJ,AK:AK,AM:AM,AN:AN" _
      ), xlWSh.Range( _
      "AP:AP,AQ:AQ,AS:AS,AT:AT,AV:AV,AW:AW,AZ:AZ,BB:BB,BC:BC,BD:BD,BF:BF,BG:BG,BI:BI" _
      )).Select
      'xlWSh.Range("BZ1").Activate
      'Apxl.Selection.EntireColumn.Hidden = True
       '  Code Segment ------------------------------------------------------
390   Apxl.Sheets(1).Select
400   Apxl.Range("BJ:BJ,BL:BL,BM:BM,BO:BO,BP:BP,BX:BX,BY:BY,CE:CE").Select
410   Apxl.Range("CE1").Activate
420   Apxl.Selection.EntireColumn.Hidden = True
       
430   xlWSh.Range("A1").Select
440   xlWBk.Close savechanges:=True
       
450   Apxl.Quit
460   Set xlWSh = Nothing
470   Set xlWBk = Nothing
480   Set Apxl = Nothing
490   Set rst = Nothing
      ' Application.Quit this kills excel and access the same time... not good
End Sub
 
Rx,

I took your code ran to see what is was doing. Then I relooked at my code ran it through the debugger with Excel visible = true to observe the Excel Workbook being formatted by my code. I saw that hidden columns was working and another formatting in my code made the columns visible (not hidden). I moved my hidden column code to the very bottom of my function prior to setting password protection and saving the Excel Worksheet in the Workbook.

I am attaching my code so other folks hopefully will not have the same problem.

Thank you for you help!!

Code: 
Option Compare Database
Option Explicit
Public Function SendTQ2XLWbSheet(strTQName As String, strSheetName As String, strFilePath As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to

' strFilePath is the name and path of the file you want to send this data into.

    Dim rst As DAO.Recordset
    Dim Apxl As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.field
    Dim FileExists As Boolean
    Dim strPath As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    ' On Error GoTo err_handler

    FileExists = False
    strPath = strFilePath

    Set rst = CurrentDb.OpenRecordset(strTQName)

    Set Apxl = CreateObject("Excel.Application")
    
    Apxl.Visible = False ' added this code
' Check if Excel Workbook exists
    If Not WorkBookExists(strPath) Then
        ' MsgBox "Excel Workbook doesn't exist and creating one!"
        Set xlWBk = Apxl.Workbooks.Add
        FileExists = False
        
        ' Check if Excel Worksheet name exists
        If Not SheetExists(strSheetName, xlWBk) Then
            ' MsgBox "Excel Worksheet doesn't exist and creating one!"
            Set xlWSh = xlWBk.Worksheets.Add
            xlWSh.Name = strSheetName
            ' xlWBk.SaveAs strPath
            ' xlWBk.Worksheets.Add().Name = strSheetName
            ' Set xlWSh = xlWBk.Worksheets(strSheetName)
            ' xlWbk.Worksheets(strSheetName).Activate
        Else
            Set xlWSh = xlWBk.Worksheets(strSheetName)
            ' xlWSh.Activate
        End If ' end to Check for Excel Worksheet
        
    ' When Workbook already exists setting workbook and worksheet
    Else
        Set xlWBk = Apxl.Workbooks.Open(strPath)
           ' Check if Excel Worksheet name exists
        If Not SheetExists(strSheetName, xlWBk) Then
            ' MsgBox "Excel Worksheet doesn't exist and creating one!"
            Set xlWSh = xlWBk.Worksheets.Add
            xlWSh.Name = strSheetName
            ' xlWBk.Worksheets.Add().Name = strSheetName
            ' Set xlWSh = xlWBk.Worksheets(strSheetName)
            ' xlWbk.Worksheets(strSheetName).Activate
        Else
            Set xlWSh = xlWBk.Worksheets(strSheetName)
            ' xlWSh.Activate
        End If ' end to Check for Excel Worksheet
        ' Set xlWSh = xlWBk.Worksheets(strSheetName)
        FileExists = True
        ' xlWSh.Activate
    End If ' end to Check for Excel Workbook
'    Apxl.Visible = True
'    Apxl.ActiveWorkbook.SaveAs FileName:=strPath
    xlWSh.Activate
    
    
    rst.MoveFirst
'Get column headers
Dim i As Integer
Dim field As String
Dim rst2 As DAO.Recordset
    Set rst2 = CurrentDb.OpenRecordset(strTQName)
    With rst2
        For i = 1 To .fields.Count
           xlWSh.Cells(1, i) = .fields(i - 1).Name
        Next i
    End With
        
    rst2.Close
    
    Set rst2 = Nothing
    
    xlWSh.Range("A2").CopyFromRecordset rst
    
' end Get column headers
   ' LastRow = ActiveSheet.UsedRange.Rows.Count
   
' FORMAT SPEND PLAN WORKBOOK
'
'    FormatAllData Macro
'
    Dim LR As Integer
    Dim Rng As String
   
    ' LR = ApXL.ActiveCell.SpecialCells(xlCellTypeLastCell).Row
'    MsgBox ApXL.ActiveCell.SpecialCells(xlCellTypeLastCell).Row
    ' MsgBox ActiveSheet.UsedRange.Select
    ' MsgBox ActiveCell.CurrentRegion.Select
    LR = xlWSh.Range("A:A").Find("*", xlWSh.Range("A1"), SearchDirection:=xlPrevious).Row
    'MsgBox xlWSh.Range("A:A").Find("*", xlWSh.Range("A1"), SearchDirection:=xlPrevious).Row
    
    Rng = "A1:BW" & CStr(LR)
    ' MsgBox Rng
    xlWSh.Range(Rng).Select
    With Apxl.Selection.Font
        .Name = "Arial"
        .Bold = False
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Apxl.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Apxl.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Apxl.Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Apxl.Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Apxl.Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Apxl.Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Apxl.Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Apxl.Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    xlWSh.Rows("1:1").Select
    Apxl.Selection.Font.Bold = True
    With Apxl.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Apxl.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    
'
' YellowHeader Macro
'
    xlWSh.Range("C1:F1").Select
    With Apxl.Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 13434879
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    xlWSh.Range("N1:AW1").Select
    With Apxl.Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 13434879
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
'
' ObjectClass Macro
'
' Calculate range
    Rng = "B1:B" & CStr(LR)
    
    xlWSh.Range(Rng).Select
    With Apxl.Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -4.99893185216834E-02
        .PatternTintAndShade = 0
    End With
    
    ' Calculate range
    Rng = "B2:B" & CStr(LR)
    
    xlWSh.Range(Rng).Select
    With Apxl.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    xlWSh.Range("B1").Select
    With Apxl.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
'
' MissionCritical Macro
'
' Calculate range
    Rng = "G1:G" & CStr(LR)
    
    xlWSh.Range(Rng).Select
    With Apxl.Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    With Apxl.Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
'
' VendorGreen Macro
'
' Calculate range
    Rng = "H1:M" & CStr(LR)
    
    xlWSh.Range(Rng).Select
    With Apxl.Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    With Apxl.Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    xlWSh.Range("H1").Select
    xlWSh.Columns("J:J").ColumnWidth = 11.71
    xlWSh.Columns("L:L").ColumnWidth = 9.29
    
'
' CapitalYellow Macro
'
' Calculate range
    Rng = "M1:M" & CStr(LR)
    
    xlWSh.Range(Rng).Select
    With Apxl.Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    xlWSh.Columns("M:M").ColumnWidth = 9.43
    
'
' TotalSpend Macro
'
' Calculate range
    Rng = "AX1:AX" & CStr(LR)
    
    xlWSh.Range(Rng).Select
    With Apxl.Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Apxl.Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    xlWSh.Columns("AX:AX").ColumnWidth = 16.71
    xlWSh.Columns("AX:AX").Select
    With Apxl.Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Apxl.Selection.ColumnWidth = 13.29
    xlWSh.Range("AX1").Select
    With Apxl.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
'
' FY12EOY Macro
'
' Calculate range
    Rng = "AY1:AY" & CStr(LR)
    
    xlWSh.Range(Rng).Select
    With Apxl.Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    xlWSh.Range("AY1").Select
    With Apxl.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
'
' QTRAUTH Macro
'
' Calculate range
    Rng = "BA1:BA" & CStr(LR)
    Rng = Rng & ",BD1:BD" & CStr(LR)
    Rng = Rng & ",BG1:BG" & CStr(LR)
    Rng = Rng & ",BJ1:BJ" & CStr(LR)
    Rng = Rng & ",BM1:BM" & CStr(LR)
    
    xlWSh.Range(Rng).Select
' Calculate range
    Rng = "BA" & CStr(LR)
    
    xlWSh.Range(Rng).Activate
    With Apxl.Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
' Calculate range
    Rng = "BM1:BM" & CStr(LR)
    
    xlWSh.Range(Rng).Select
    With Apxl.Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    
'
' QTRPLAN Macro
'
    
    xlWSh.Range("AZ1,BC1,BF1,BI1,BL1").Select
    xlWSh.Range("BL1").Activate
    With Apxl.Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 52479
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
' Calculate range
    Rng = "AZ2:AZ" & CStr(LR)
    Rng = Rng & ",BC2:BC" & CStr(LR)
    Rng = Rng & ",BF2:BF" & CStr(LR)
    Rng = Rng & ",BI2:BI" & CStr(LR)
    Rng = Rng & ",BL2:BL" & CStr(LR)
    
    xlWSh.Range(Rng).Select
' Calculate range
    Rng = "BL" & CStr(LR)
    
    xlWSh.Range(Rng).Activate
    With Apxl.Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    xlWSh.Range("BL1").Select
    With Apxl.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
'
' TABDIV Macro
'
' Calculate range
    Rng = "BO2:BP" & CStr(LR)
    xlWSh.Range(Rng).Select
    With Apxl.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
'
' RecordInfo Macro
'
'
    xlWSh.Columns("C:C").ColumnWidth = 15.14
    xlWSh.Columns("C:C").Select
    With Apxl.Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    xlWSh.Range("D1").Select
    xlWSh.Columns("D:D").ColumnWidth = 19.86
    xlWSh.Columns("D:D").Select
    With Apxl.Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    xlWSh.Range("E1").Select
    xlWSh.Columns("E:E").ColumnWidth = 25.71
    xlWSh.Columns("E:E").Select
    With Apxl.Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    xlWSh.Columns("F:F").Select
    Apxl.Selection.ColumnWidth = 22.71
    xlWSh.Columns("F:F").Select
    With Apxl.Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
'
' ReqNum Macro
'
'
    xlWSh.Columns("A:A").ColumnWidth = 14.71
' Calculate range
    Rng = "A1:A" & CStr(LR)
    
    xlWSh.Range(Rng).Select
    With Apxl.Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
'
' Qtr Actual
'
' Calculate range
    Rng = "BB1:BB" & CStr(LR)
    Rng = Rng & ",BE1:BE" & CStr(LR)
    Rng = Rng & ",BH1:BH" & CStr(LR)
    Rng = Rng & ",BK1:BK" & CStr(LR)
    Rng = Rng & ",BN1:BN" & CStr(LR)
    
    xlWSh.Range(Rng).Select
    With Apxl.Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 16737996
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
'
' ColumnFormat Macro
'
'
    xlWSh.Columns("B:B").Select
    Apxl.Selection.ColumnWidth = 8.43
    With Apxl.Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Apxl.Selection.ColumnWidth = 7.57
    Apxl.Selection.ColumnWidth = 6.86
    xlWSh.Columns("G:G").Select
    With Apxl.Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    xlWSh.Columns("AY:AY").Select
    With Apxl.Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Apxl.Selection.ColumnWidth = 11.43
    xlWSh.Columns("AJ:AJ").Select
    With Apxl.Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Apxl.Selection.ColumnWidth = 11.14
    xlWSh.Columns("AX:AX").Select
    With Apxl.Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Apxl.Selection.ColumnWidth = 13
    
'
'FYDP Color
'
' Calculate range
    Rng = "BQ1:BU" & CStr(LR)
    
    xlWSh.Range(Rng).Select
    With Apxl.Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    
'
' Dollars Macro
'
' Calculate range
    Rng = "N2:BN" & CStr(LR)
    
    xlWSh.Range(Rng).Select
    Apxl.Selection.NumberFormat = "$#,##0.00"
    
    
'
' DarkUnderline Macro
'
' Calculate range
    Rng = "A1:BW" & CStr(LR)
    
    xlWSh.Range(Rng).Select
    Apxl.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Apxl.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Apxl.Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Apxl.Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Apxl.Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Apxl.Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Apxl.Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Apxl.Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ' Calculate range
    Rng = "A2:BW" & CStr(LR)
    
    xlWSh.Range(Rng).Select
    Apxl.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Apxl.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Apxl.Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Apxl.Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Apxl.Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Apxl.Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Apxl.Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Apxl.Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
' Call Function to delete sheet 1, 2, & 3 tabs
    Call DeleteTabs(Apxl, xlWBk)
    
' selects all of the cells
    Apxl.ActiveSheet.Cells.Select
'
' Hide Columns
'

    ' does the "autofit" for all columns
    Apxl.ActiveSheet.Cells.EntireColumn.AutoFit
    
'
' Select cells to protect ... specifically the calculated fields
'
' Calculate range
    Rng = "A1:BW1, A2:A" & CStr(LR) & " , AX2:BN" & CStr(LR)
    
    xlWSh.Cells.Locked = False
    xlWSh.Range(Rng).Locked = True
    
    '
' Hide Columns
'
'
   xlWSh.Range("O:O,P:P,R:R,S:S,U:U,V:V,X:X,Y:Y").EntireColumn.Hidden = True
   xlWSh.Range("AA:AA,AB:AB,AD:AD,AE:AE,AG:AG,AH:AH,AJ:AJ,AK:AK,AM:AM,AN:AN,AP:AP,AQ:AQ,AS:AS,AT:AT,AV:AV,AW:AW,AZ:AZ").EntireColumn.Hidden = True
   xlWSh.Range("BB:BB,BC:BC,BD:BD,BF:BF,BG:BG,BI:BI,BJ:BJ,BL:BL,BM:BM,BO:BO,BP:BP,BX:BX,BY:BY,BZ:BZ").EntireColumn.Hidden = True
   xlWSh.Range("CE:CE,CD:CD,CC:CC,CB:CB,CA:CA").EntireColumn.Hidden = True
'   Apxl.Visible = True
'    Apxl.Sheets(strSheetName).Select
'    Apxl.Range("BJ:BJ,BL:BL,BM:BM,BO:BO,BP:BP,BX:BX,BY:BY,CE:CE").Select
'    Apxl.Range("CE1").Activate
'    Apxl.Selection.EntireColumn.Hidden = True
    
    Apxl.ActiveSheet.Protect Password:="Password"
'    Apxl.Visible = False
'
' UnHide Columns
'
'
'    Columns("C:F").Select
'    Selection.EntireColumn.Hidden = False
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
   'Save the Workbook and Quit Excel
    If FileExists Then
        xlWBk.Close savechanges:=True
    Else
        xlWBk.SaveAs strPath
    End If ' ending checking for saving workbook
    
    rst.Close
    
    Apxl.Quit
    Set xlWSh = Nothing
    Set xlWBk = Nothing
    Set Apxl = Nothing
    Set rst = Nothing
    ' Application.Quit  this kills excel and access the same time... not good
Exit_SendTQ2XLWbSheet:
    Exit Function

err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendTQ2XLWbSheet
End Function
 
Thanks for sharing the success. There will be someone else who is getting started at some point. It can be the process that makes all the difference.
Sorry I forgot to mention putting all that type of code at the end.
I often put the column widths close to the end because the printer zoom can affect that kind of thing.
 
You must log in or register to reply here.

Similar threads

Z
Attempts to make my code more efficient don't work
Replies
5
Views
556
Zedster
Z
B
Solved VBA code which exports data from Access to Excel and then loops through the Excel file
Replies
0
Views
731
BlueFllame
B
Kayleigh
Solved Error sending report to Excel
Replies
3
Views
1,157
Kayleigh
Kayleigh
P
Export to Excel not working after SetAccessWindow code
Replies
4
Views
1,285
isladogs
isladogs
P
Proper Error Handling
Replies
14
Views
2,203
psyc0tic1
P

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom