Find and select multiple cells within a worksheet - excel

Question

I am new to writing macros and have search everywhere for a solution to my problem with no luck, so I'm hoping for some help here.
I have an Excel spreadsheet containing multiple calculation which are automated. This means a big part of the spreadsheet is locked for other users who only need to do the calculations. Basically what I want is to have this spreadsheet in two different languages. So using a macro I want to change all the text content in my spreadsheet from one language to another. Since i only want one spreadsheet (because I keep updating it and adding new calculations to it) I thought a macro with a button to switch between the 2 language was the best solution.
Here is my problem. I used find and replace to replace each word which is working fine.
Sub Rename_EN()
'
ActiveSheet.Unprotect
Cells.Select
Selection.Replace What:="rød", Replacement:="red", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="grøn", Replacement:="green", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="blå", Replacement:="blue", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Flt-tag", Replacement:="FLT-roof", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
But the text also have technical terms, fx. I want F_(LT-tag) to be replaced with F_(LT-roof), but with (LT-roof) as a sub-scripted text.
I searched for a long time and came to the conclusion that it is not possible to simple subscript the text in a code. (if it is, then please feel free to tell me how :)) I then found this code that can change specific characters to subscript and superscript:
Sub Super_Sub()
Dim NumSub
Dim NumSuper
Dim SubL
Dim SubR
Dim SuperL
Dim SuperR
Dim CheckSub
Dim CounterSub
Dim CheckSuper
Dim CounterSuper
Dim Cell
'
CheckSub = True
CounterSub = 0
CheckSuper = True
CounterSuper = 0
Cell = ActiveCell
'
NumSub = Len(Cell) - Len(Application.WorksheetFunction.Substitute(Cell, "[", ""))
NumSuper = Len(Cell) - Len(Application.WorksheetFunction.Substitute(Cell, "{", ""))
'
If Len(Cell) = 0 Then Exit Sub
If IsError(Application.Find("[", ActiveCell, 1)) = False Then
Do
Do While CounterSub <= 1000
SubL = Application.Find("[", ActiveCell, 1)
SubR = Application.Find("]", ActiveCell, 1)
ActiveCell.Characters(SubL, 1).Delete
ActiveCell.Characters(SubR - 1, 1).Delete
ActiveCell.Characters(SubL, SubR - SubL - 1).Font.Subscript = True
CounterSub = CounterSub + 1
If CounterSub = NumSub Then
CheckSub = False
Exit Do
End If
Loop
Loop Until CheckSub = False
End If
'
'
If IsError(Application.Find("{", ActiveCell, 1)) = False Then
Do
Do While CounterSuper <= 1000
SuperL = Application.Find("{", ActiveCell, 1)
SuperR = Application.Find("}", ActiveCell, 1)
ActiveCell.Characters(SuperL, 1).Delete
ActiveCell.Characters(SuperR - 1, 1).Delete
ActiveCell.Characters(SuperL, SuperR - SuperL - 1).Font.Superscript = True
CounterSuper = CounterSuper + 1
If CounterSuper = NumSuper Then
CheckSuper = False
Exit Do
End If
Loop
Loop Until CheckSuper = False
End If
'
End Sub
So I wanted to make a button that would run the macros in a specific order. The problem here is, that I need to select the cells with { and [ to run the code.
Can I rewrite this code to be used for a whole spreadsheet? I again searched for a solution and couldn't find one, so I tried to make yet another macro to run before this, that finds and selects all cells in a sheets containing { and [. Again I hit a wall since I can't get the it to select multiple cells in a whole sheet.

Answer 1

One way I can think of doing it is to have a second hidden sheet containing the replacement text in the relevant cells. You can then use FIND to find all cells containing a value, check it doesn't hold a formula and swap the value with that held in the second sheet.
Sub Test()
Dim firstAddress As String
Dim rCell As Range
Dim sValue As String
Dim MainSheet As Worksheet
Dim SecondSheet As Worksheet
'MainSheet contains your formula & text.
'SecondSheet only contains values in the text cells.
With ThisWorkbook
Set MainSheet = .Worksheets("Sheet1")
Set SecondSheet = .Worksheets("Sheet2")
End With
Set rCell = MainSheet.Cells.Find("*", , xlValues, xlWhole, , xlNext, True)
If Not rCell Is Nothing Then
firstAddress = rCell.Address
Do
'If the cell doesn't contain a formula swap its value with
'the value held in the second sheet.
If Not rCell.HasFormula Then
sValue = rCell.Value
rCell.Value = SecondSheet.Range(rCell.Address).Value
SecondSheet.Range(rCell.Address).Value = sValue
End If
Set rCell = MainSheet.Cells.FindNext(rCell)
Loop While rCell.Address <> firstAddress
End If
End Sub