Hello -
I have this macro below which works PERFECT, except for one thing now. I am trying clean up the presentation and was hoping there was an easy way to add in a statement whereby all cells in the new workbook were white background - i.e. no gridlines showing outside of any tables present. Is that something easy I can add into my existing code here now?
Thanks in advance for any guidance and assistances here.
Sub Export()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim wsSummary As Worksheet, wbNew As Workbook, wsNewSummary As Worksheet
Dim loDD_Data As ListObject
Dim i As Integer, lngInsertRow As Long
'Source Summary Worksheet
Set wsSummary = ThisWorkbook.Worksheets("Summary")
'Source DD_Data table
Set loDD_Data = ThisWorkbook.Worksheets("AllData").ListObjects("DD_Data")
'Create a new workbook
Set wbNew = Workbooks.Add
'New Summary Worksheet
wbNew.Worksheets(1).Name = wsSummary.Name
Set wsNewSummary = wbNew.Worksheets(1)
'Delete any extra worksheets in the new workbook, if present
If wbNew.Worksheets.Count > 1 Then
For i = wbNew.Worksheets.Count To 2 Step -1
wbNew.Worksheets(i).Delete
Next
End If
'Copy the Job Summary Range
wsSummary.Range("rngJobSummary").Copy
'Paste to the new Summary worksheet
With wsNewSummary.Cells(1, 1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
'Delete the data validation dropdown from cell B1 on the new summary worksheet
wsNewSummary.Cells(1, 2).Validation.Delete
'Find the last row on the worksheet and add 3 rows, this will be the insert row for the PivotTable values
lngInsertRow = wsNewSummary.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row + 3
'Copy the PivotTable TableRange1
wsSummary.PivotTables(1).TableRange1.Copy
'Paste the formats and values to the new Summary worksheet
With wsNewSummary.Cells(lngInsertRow, 1)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
'Remove the wrap text from the copied PivotTable range
Selection.WrapText = False
'Find the last row on the worksheet and add 3 rows, this will be the insert row for the AllData table values
lngInsertRow = wsNewSummary.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row + 3
'Remove the filters from the AllData table
Call modTableFunctions.fnShowAllData(loDD_Data)
'Filter the AllData table
Call modTableFunctions.sbFilterListObject(loDD_Data, loDD_Data.ListColumns("Job Number").Index, wsNewSummary.Cells(1, 2).Value, False)
'Filtered table returns one or more rows
If loDD_Data.DataBodyRange.Cells.SpecialCells(xlCellTypeVisible).Rows.Count > 0 Then
'Copy the header row range
loDD_Data.HeaderRowRange.Copy
'Paste the header row range to the new Summary worksheet
wsNewSummary.Cells(lngInsertRow, 1).PasteSpecial xlPasteValues
'Increase font size of copied header row range using the CurrentRegion
wsNewSummary.Cells(lngInsertRow, 1).CurrentRegion.Font.Size = 14
'Copy the visible data body range
loDD_Data.DataBodyRange.Cells.SpecialCells(xlCellTypeVisible).Copy
'Paste the visible data body range to the new Summary worksheet
With wsNewSummary.Cells(lngInsertRow + 1, 1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
End If
'Activate the New Summary worksheet
wsNewSummary.Activate
'Add Auto Filter
wsNewSummary.Range(Cells(lngInsertRow, 1), Selection.Cells.SpecialCells(xlCellTypeLastCell)).AutoFilter
'Remove the filters from the AllData table
Call modTableFunctions.fnShowAllData(loDD_Data)
'Activeate the Summary Worksheet in the macro workbook
wsSummary.Activate
'Autofit the column widths on the current worksheet
wsNewSummary.UsedRange.Columns.AutoFit
wsNewSummary.Activate
wsNewSummary.Cells(1, 2).Select
Application.DisplayAlerts = True
End Sub
I have this macro below which works PERFECT, except for one thing now. I am trying clean up the presentation and was hoping there was an easy way to add in a statement whereby all cells in the new workbook were white background - i.e. no gridlines showing outside of any tables present. Is that something easy I can add into my existing code here now?
Thanks in advance for any guidance and assistances here.
Sub Export()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim wsSummary As Worksheet, wbNew As Workbook, wsNewSummary As Worksheet
Dim loDD_Data As ListObject
Dim i As Integer, lngInsertRow As Long
'Source Summary Worksheet
Set wsSummary = ThisWorkbook.Worksheets("Summary")
'Source DD_Data table
Set loDD_Data = ThisWorkbook.Worksheets("AllData").ListObjects("DD_Data")
'Create a new workbook
Set wbNew = Workbooks.Add
'New Summary Worksheet
wbNew.Worksheets(1).Name = wsSummary.Name
Set wsNewSummary = wbNew.Worksheets(1)
'Delete any extra worksheets in the new workbook, if present
If wbNew.Worksheets.Count > 1 Then
For i = wbNew.Worksheets.Count To 2 Step -1
wbNew.Worksheets(i).Delete
Next
End If
'Copy the Job Summary Range
wsSummary.Range("rngJobSummary").Copy
'Paste to the new Summary worksheet
With wsNewSummary.Cells(1, 1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
'Delete the data validation dropdown from cell B1 on the new summary worksheet
wsNewSummary.Cells(1, 2).Validation.Delete
'Find the last row on the worksheet and add 3 rows, this will be the insert row for the PivotTable values
lngInsertRow = wsNewSummary.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row + 3
'Copy the PivotTable TableRange1
wsSummary.PivotTables(1).TableRange1.Copy
'Paste the formats and values to the new Summary worksheet
With wsNewSummary.Cells(lngInsertRow, 1)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
'Remove the wrap text from the copied PivotTable range
Selection.WrapText = False
'Find the last row on the worksheet and add 3 rows, this will be the insert row for the AllData table values
lngInsertRow = wsNewSummary.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row + 3
'Remove the filters from the AllData table
Call modTableFunctions.fnShowAllData(loDD_Data)
'Filter the AllData table
Call modTableFunctions.sbFilterListObject(loDD_Data, loDD_Data.ListColumns("Job Number").Index, wsNewSummary.Cells(1, 2).Value, False)
'Filtered table returns one or more rows
If loDD_Data.DataBodyRange.Cells.SpecialCells(xlCellTypeVisible).Rows.Count > 0 Then
'Copy the header row range
loDD_Data.HeaderRowRange.Copy
'Paste the header row range to the new Summary worksheet
wsNewSummary.Cells(lngInsertRow, 1).PasteSpecial xlPasteValues
'Increase font size of copied header row range using the CurrentRegion
wsNewSummary.Cells(lngInsertRow, 1).CurrentRegion.Font.Size = 14
'Copy the visible data body range
loDD_Data.DataBodyRange.Cells.SpecialCells(xlCellTypeVisible).Copy
'Paste the visible data body range to the new Summary worksheet
With wsNewSummary.Cells(lngInsertRow + 1, 1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
End If
'Activate the New Summary worksheet
wsNewSummary.Activate
'Add Auto Filter
wsNewSummary.Range(Cells(lngInsertRow, 1), Selection.Cells.SpecialCells(xlCellTypeLastCell)).AutoFilter
'Remove the filters from the AllData table
Call modTableFunctions.fnShowAllData(loDD_Data)
'Activeate the Summary Worksheet in the macro workbook
wsSummary.Activate
'Autofit the column widths on the current worksheet
wsNewSummary.UsedRange.Columns.AutoFit
wsNewSummary.Activate
wsNewSummary.Cells(1, 2).Select
Application.DisplayAlerts = True
End Sub