Excel: Get a sheet ready for the customer
Usually sending a spreadsheet to a customer requires you to make sure that everything is static in the spreadsheet.
Here is a macro that takes a sheet and converts all the formulas into static cells, and removes all hidden columns. It then checks for any hidden rows and asks you whether you want to remove them too.
NOTE: The original sheet isn't deleted and is still available. This original sheet will have "ori" added to the sheet name. You will need to manually delete this original sheet. This allows you to run the macro to take a static snapshot of a sheet while retaining the original.
Sub Break_Links_and_Remove_Hidden_ColumnsRows()
'
' Convert a sheet into a static version:
' 1. Create a copy of the active sheet.
' 2. Copy and paste everything as values.
' 3. Delete all hidden columns.
' 4. Delete all hidden rows.
' 5. Unfreeze panes to make sure that everything is revealed.
'
'
Dim currentSheet As Worksheet
Dim staticsheet As Worksheet
Dim col As Range
Dim reverseCol As New Collection
Dim row As Range
Dim reverseRow As New Collection
Dim sheetName As String
extension = "ori"
Set currentSheet = ActiveSheet
sheetName = currentSheet.Name
response = MsgBox("Press OK to make all the links on the sheet " & vbLf & "static, and to delete all hidden columns. NOTE: You will need to refreeze panes.", vbOKCancel)
If response = vbCancel Then Exit Sub
If Right(currentSheet.Name, 3) = extension Then ' There's already a static sheet available
sheetName = Left(currentSheet.Name, Len(currentSheet.Name) - Len(extension)) ' strip off "ori"
If sheetExists(sheetName) Then
Worksheets(sheetName).Copy Before:=currentSheet ' Create a copy of the sheet with auto-increment
Application.DisplayAlerts = False
Worksheets(sheetName).Delete ' Delete the sheet so the auto-incremented sheet remains
Application.DisplayAlerts = True
End If
ElseIf sheetExists(Left(sheetName, 31 - Len(extension)) & extension) Then ' The user selected the wrong sheet. No worries I got this.
sheetName = currentSheet.Name
Worksheets(sheetName).Copy Before:=currentSheet ' Create a copy of the sheet with auto-increment
Application.DisplayAlerts = False
Worksheets(sheetName).Delete ' Delete the assumed sheet so everything is good to go
Application.DisplayAlerts = True
Set currentSheet = Worksheets(Left(sheetName, 31 - Len(extension)) & extension)
Else
sheetName = currentSheet.Name
currentSheet.Name = Left(sheetName, 31 - Len(extension)) & extension
End If
currentSheet.Copy Before:=currentSheet
Set staticsheet = Sheets(currentSheet.Index - 1)
staticsheet.Name = sheetName
staticsheet.Cells.Select
Selection.Copy
staticsheet.Range("A1").Select
Application.DisplayAlerts = False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.DisplayAlerts = True
Application.CutCopyMode = False
' Reverse the collection, otherwise when you delete a column it will then affect the next found column.
For Each col In staticsheet.UsedRange.Columns
If reverseCol.Count > 0 Then
reverseCol.Add Item:=col, Before:=1
Else
reverseCol.Add Item:=col
End If
Next
For Each col In reverseCol
If col.Hidden = True Or col.ColumnWidth = 0 Then
col.EntireColumn.Delete ' Delete any columns that are hidden
End If
Next col
' Reverse the collection, otherwise when you delete a row it will then affect the next found row.
For Each row In staticsheet.UsedRange.Rows
If reverseRow.Count > 0 Then
reverseRow.Add Item:=row, Before:=1
Else
reverseRow.Add Item:=row
End If
Next
' Check if there are any hidden rows
DeleteHiddenRows = vbNo
For Each row In reverseRow
If row.Hidden = True Or row.RowHeight = 0 Then
DeleteHiddenRows = MsgBox("Do you wish to also delete hidden rows?", vbYesNo)
Exit For
End If
Next row
If DeleteHiddenRows = vbYes Then
For Each row In reverseRow
If row.Hidden = True Or row.RowHeight = 0 Then
row.EntireRow.Delete ' Delete any row that is hidden
End If
Next row
End If
ActiveWindow.FreezePanes = False
End Sub