Changing all remaining sheets to values, keeping the table format.

MPaul100

New Member
Joined
Aug 21, 2019
Messages
24
Hi, I have the following code, that should delete some sheets, change to values and protect the other ones, save and close. it works, except for one sheet(Units) that contains a table. In this one, the content gets twisted, showing formulas pasted as values and out of 500 lines, 25-30 are copied everywhere.
I have no clue why. Can someone take a look on it?
Code:
Sub SaveReport()
    Dim xWs As Worksheet
    Dim path As String
    Dim name As String
    Dim pwd As String


    path = ""
    name = "Balance" & ThisWorkbook.Sheets("Admin").Range("F3").Value
    pwd = "password1"
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlManual
    For Each xWs In Application.ThisWorkbook.Worksheets
        If xWs.name <> "Units" And xWs.name <> "Overview" And xWs.name <> "OM" And xWs.name <> "OD" Then
            xWs.Delete
        End If
    Next
    For Each xWs In ThisWorkbook.Worksheets
        With xWs.UsedRange
            .Value = .Value
        End With
        xWs.Protect Password:=pwd, UserInterfaceOnly:=True
    Next xWs
    
ThisWorkbook.SaveAs FileName:=path & name, FileFormat:=51
ThisWorkbook.Close savechanges:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Fixed by changing second For Each to:
Code:
    For Each xWs In ThisWorkbook.Worksheets
         For Each rng In xWs.UsedRange
            If rng.HasFormula Then
                rng.Formula = rng.Value
            End If
        Next rng
        xWs.Protect Password:=pwd, UserInterfaceOnly:=True
    Next xWs
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,915
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top