Use Wildcards in Replace Function in combination with 2D Array Values - arrays

Question

I'm trying to go through a list with two columns and replace some of the text in the second column. I want to search for values using wildcards in combination with a value inside a 2D Array.
I've a file with all Pokemon cards separated in different worksheets by the set they're in. There are two columns that are called "Name" and "German Name".
I created another worksheet that contains all cards and their corresponding name and German name. Out of that worksheet, I create a 2 dimensional Array. This works.
Then I've loops going on and inside that I've got this line of code.
Worksheets(table).Cells(otherI, 2).Value = Replace(Worksheets(table).Cells(otherI, 2).Value, " * " & allArray(i, 0) & " * ", " * " & allArray(i, 1) & " * ")
Somewhere there is the problem.
E.g. I've the entry "Bulbasaur Lv.5" in both columns and now I want to replace "Bulbasaur" in the second column with its German equivalent "Bisasam" but the "Lv.5" mustn't be touched.
The whole script.
Option Explicit
Sub firstMakro()
'Variables
Dim allSize As Integer
Dim allArray()
Dim allI As Integer
allI = 1
Dim otherSize As Integer
Dim otherI As Integer
otherI = 1
Dim i As Integer
Dim table As Integer
table = 2
'Create Array
allSize = WorksheetFunction.CountA(Worksheets("All_Pokemons").Columns(1))
ReDim allArray(allI To allSize, 1)
Do
allArray(allI, 0) = Worksheets("All_Pokemons").Cells(allI, 1).Value
allArray(allI, 1) = Worksheets("All_Pokemons").Cells(allI, 2).Value
allI = allI + 1
Loop Until allI > allSize
MsgBox ("Array created")
'Replace Entries
For i = LBound(allArray, 1) To UBound(allArray, 1)
MsgBox (allArray(i, 0))
otherSize = WorksheetFunction.CountA(Worksheets(table).Columns(1))
Do
Worksheets(table).Cells(otherI, 2).Value = Replace(Worksheets(table).Cells(otherI, 2).Value, " * " & allArray(i, 0) & " * ", " * " & allArray(i, 1) & " * ")
otherI = otherI + 1
Loop Until otherI > otherSize
otherI = 1
Next i
End Sub

Answer 1

Replace doesn't use, or in this case even need, wildcards. Use
Replace(Worksheets(table).Cells(otherI, 2).Value, allArray(i, 0), allArray(i, 1))

Answer 2

Range Replace
Range.Replace (Microsoft Docs)
Tested only on a small dataset (feedback on efficiency (speed) is appreciated).
It will replace each occurrence of an English name with the associated German name in the whole destination range.
Adjust the values in the constants section.
Option Explicit
Sub Germanize()
Const sName As String = "All_Pokemons"
Const sfRow As Long = 2 ' ??? First Row
Const seCol As String = "A" ' ENG
Const sgCol As String = "B" ' GER
Const dName As String = "Sheet2" ' ??? Worksheet Tab Name
Const dfRow As Long = 2 ' ??? First Row
Const deCol As String = "A" ' ENG
Const dgCol As String = "B" ' GER
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Source (All)
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim serg As Range: Set serg = RefColumn(sws.Cells(sfRow, seCol)) ' ENG
If serg Is Nothing Then Exit Sub ' no data
Dim seData As Variant: seData = GetRange(serg) ' ENG
Dim sgrg As Range: Set sgrg = serg.EntireRow.Columns(sgCol) ' GER
Dim sgData As Variant: sgData = GetRange(sgrg) ' GER
' Destination
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim derg As Range: Set derg = RefColumn(dws.Cells(dfRow, deCol)) ' ENG
If derg Is Nothing Then Exit Sub ' no data
Dim dgrg As Range: Set dgrg = derg.EntireRow.Columns(dgCol) ' GER
Application.ScreenUpdating = False
dgrg.Value = derg.Value ' write ENG column to GER column
Dim seValue As Variant
Dim r As Long
' Replace in GER column.
For r = 1 To UBound(seData, 1)
seValue = seData(r, 1)
If Not IsError(seValue) Then
If Len(seValue) > 0 Then
dgrg.Replace seValue, CStr(sgData(r, 1)), xlPart, , False
End If
End If
Next r
Application.ScreenUpdating = True
MsgBox "German pokemon names updated.", vbInformation
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Creates a reference to the one-column range from the first cell
' of a range ('FirstCell') to the bottom-most non-empty cell
' of the first cell's worksheet column.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefColumn( _
ByVal FirstCell As Range) _
As Range
Const ProcName As String = "RefColumn"
On Error GoTo ClearError
With FirstCell.Cells(1)
Dim lCell As Range
Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If lCell Is Nothing Then Exit Function
Set RefColumn = .Resize(lCell.Row - .Row + 1)
End With
ProcExit:
Exit Function
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the values of a range ('rg') in a 2D one-based array.
' Remarks: If ˙rg` refers to a multi-range, only its first area
' is considered.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetRange( _
ByVal rg As Range) _
As Variant
Const ProcName As String = "GetRange"
On Error GoTo ClearError
If rg.Rows.Count + rg.Columns.Count = 2 Then ' one cell
Dim Data As Variant: ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
GetRange = Data
Else ' multiple cells
GetRange = rg.Value
End If
ProcExit:
Exit Function
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Function