Some days ago I got the following code from Norman David Jones: Alt-F11 to open

Question

Some days ago I got the following code from Norman David Jones:

Alt-F11 to open the VBA editor

Alt-IM to insert a new code module

In the new module, paste the following code

'==========>>

Option Explicit

'---------->>
Public Sub ToggleFormula()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim myRng As Range
Dim LRow As Long
Dim NME As Name

Set WB = ActiveWorkbook
Set SH = ActiveSheet
  
With SH
LRow = Cells(Rows.Count, "R").End(xlUp).Row
Set Rng = SH.Range("R2:R" & LRow)
End With

Set myRng = Selection
Rng.Cells(1).Select

On Error Resume Next
Set NME = WB.Names("myFormula")
On Error GoTo 0

With Rng
If .Cells(1).HasFormula Then
Set NME = WB.Names.Add(Name:="myFormula", _
RefersTo:=Rng.Cells(1).FormulaR1C1)
.Value = .Value
Else
.Formula = NME.RefersTo
End If
End With
myRng.Select
End Sub
'<<==========

Alt-Q to close the VBA editor

Assign the macro ToggleFormula to your button.

I wonder if Norman might be out there somewhere. If so I would like to ask if you could help me a bit more.

Instead of just column R I now have a sheet with formulas in A3:CS15387 (awfully, but it is not my file) which I would like to use the above code to.

Regards

Explanation / Answer

In order to avoid copy/paste errors (principally, mine!), the complete code should now be:

'==========>>
Option Explicit

Public Sub ToggleFormula()

Dim WB As Workbook
Dim SH As Worksheet, copySH As Worksheet
Dim Rng As Range, rngFormulas As Range, destRng As Range
Dim LRow As Long
Dim CalcMode As Long

Const sCopyShName As String = "CopyFormulaSheet"

Const sDataSheetName As String = "CountryDetails"' '<<==== Adapt as required
Const nFirstRow As Long = 3    '<<==== Adapt as required

Const myColumns As String = "A:CS" '<<==== Adapt as required

Set WB = ActiveWorkbook

With WB
Set SH = .Sheets(sDataSheetName)
On Error Resume Next
Set copySH = .Sheets(sCopyShName)
On Error GoTo 0
If copySH Is Nothing Then
Set copySH = .Sheets.Add(after:=.Sheets(.Sheets.Count))
With copySH
.Name = sCopyShName
.Visible = xlSheetVeryHidden
End With
End If
End With

With SH
LRow = LastRow(SH, .Range(myColumns))
Set Rng = SH.Range(myColumns).Rows(1).Offset(nFirstRow - 1).Resize(LRow - nFirstRow + 1)
End With

On Error Resume Next
Set rngFormulas = Rng.SpecialCells(xlCellTypeFormulas)
On Error GoTo XIT

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

If Not rngFormulas Is Nothing Then
With copySH
.UsedRange.Delete
Set destRng = .Range(Rng.Address)
Rng.Copy Destination:=destRng
.UsedRange.Replace What:="=", Replacement:="Z#Z="
End With
With Rng
.Value = .Value
End With
Else
With copySH
.UsedRange.Replace What:="Z#Z=", Replacement:="="
.Range(Rng.Address).Copy Destination:=Rng
End With
End If

XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub

'---------->>
Function LastRow(SH As Worksheet, _
Optional Rng As Range)
If Rng Is Nothing Then
Set Rng = SH.Cells
End If

On Error Resume Next
LastRow = Rng.Find(What:="*", _
after:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<==========

Related Questions

Navigate

• Browse (All)
• Browse S
• Subjects

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.