VBA Excel 2010 Hide Non Adjacent Columns code not working

**captdkl02** · 01-23-2013, 10:53 AM

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"

'
' Hide Columns
'
'
' 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
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


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

**ssanfu** · 01-23-2013, 04:30 PM

First, you need (should) close the recordset "rst2" before you destroy it

Code:

   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  ' << add this line
   Set rst2 = Nothing

Second, the Union problem. In Help, it looks like the Union should be assigned to a variable:
(quote from Help)

Using the Union Method

You can combine multiple ranges into one Range object using the Union method. The following example creates a Range object called myMultipleRange, defines it as the ranges A1:B2 and C3:D4, and then formats the combined ranges as bold.

Sub MultipleRange()
Dim r1, r2, myMultipleRange As Range
Set r1 = Sheets("Sheet1").Range("A1:B2")
Set r2 = Sheets("Sheet1").Range("C3:D4")
Set myMultipleRange = Union(r1, r2)
myMultipleRange.Font.Bold = True
End Sub

Maybe the above will work.

Another thought:
You don't have to select the range or activate it before hiding it.
Would this work for you? (I might have the syntax wrong...)

comment out this code

Code:

   Apxl.Union(xlWSh.Range( _
              "BJ:BJ,BL:BL,BM:BM,BO:BO,BP:BP,BX:BX,BY:BY,CE:CE,C D: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,B C:BC,BD:BD,BF:BF,BG:BG,BI:BI" _
                 )).Select
   xlWSh.Range("BZ1").Activate
   Apxl.Selection.EntireColumn.Hidden = True

Add this

Code:

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

Hard to test this without the dB :(

**captdkl02** · 01-24-2013, 07:25 AM

Steve,

I appreciate about comment about closing rst2. I tried your code in place of my union code of hiding columns. The columns are still not hidden after running the code. No errors. Any other thoughts??

Thank you.

**ketbdnetbp** · 01-24-2013, 11:38 AM

captdkl02 -

Just for S&G's, you could try...

xlWSh.Range("O:P,R:S,U:V,X:Y,AA:AB,AD:AE,AG:AH,AJ: AK,AM:AN,AP:AP,AQ:AQ,AS:AT,AV:AW,AZ:AZ,BB:BD,BF:BG ,BI:BJ,BL:BM,BO:BP,BX:BZ,CA:CE").Select
xlWSh.Range("CE1").Activate
Selection.EntireColumn.Hidden = True "or Apxl.Selection.EntireColumn.Hidden = True

and see if this changes the outcome.

All the best,

Jim

**ssanfu** · 01-24-2013, 01:39 PM

Maybe post your dB (remove/change any sensitive data) with a few record for testing purposes...???

**captdkl02** · 01-24-2013, 02:54 PM

Steve,

I ended finding the issue. My code was working too good. There was some other formatting made the hidden fields become visible prior to me saving the excel sheet. I moved the hidden code segment to the bottom of my formatting routine prior to me password protecting and saving the Excel worksheet.

I am attaching the code so other folks might gain benefit from it.

I appreciate your hints and response.

Thank you.

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

**ssanfu** · 01-24-2013, 03:15 PM

Excellent. And thanks for the update and code.

VBA Excel 2010 Hide Non Adjacent Columns code not working

Thread Tools

VBA Excel 2010 Hide Non Adjacent Columns code not working

Similar Threads

Hide Columns in Query Result based on Text Box Value

show / hide columns based on criteria?

Excel code not working with Excel open

Working with OLE excel charts in Access 2010

Show/Hide Columns in a Query

Posting Permissions