T4176_Replace All Old Name With New Names Using 1D Arrays

https://excel-egy.com/forum/t4167
---------------------------------

Sub Replace_All_Old_Name_With_New_Names_Using_1D_Arrays()
    Dim oldNames, newNames, ws As Worksheet, i As Long

    With ThisWorkbook.Worksheets(1)
        oldNames = ConvertTo1DArray(.Range("C6:C" & .Cells(Rows.Count, "C").End(xlUp).Row).Value)
        newNames = ConvertTo1DArray(.Range("D6:D" & .Cells(Rows.Count, "D").End(xlUp).Row).Value)
    End With

    Application.ScreenUpdating = False
        For i = LBound(oldNames) To UBound(oldNames)
            For Each ws In ThisWorkbook.Worksheets
                If ws.Index <> Worksheets(1).Index Then
                    ws.Cells.Replace What:=oldNames(i), Replacement:=newNames(i), LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                End If
            Next ws
        Next i
    Application.ScreenUpdating = True

    MsgBox "Done...", 64
End Sub

Function ConvertTo1DArray(arr As Variant)
    Dim b(), s As String, i As Long
    ReDim b(0 To UBound(arr, 1) - 1)

    For i = 1 To UBound(arr, 1)
        b(i - 1) = arr(i, 1)
    Next i

    ConvertTo1DArray = b
End Function