Extract same number and name in a cell

Hi all,

I have an issue when extracting same phone number and client name in a cell

I want to remove the same phone number and client name that don't have phone number

The result
- Because ABCD is a client name but it doesn't have phone number, I remove the name
- 0933710850 XYZW is the same information , so 0933710850 XYZW is removed
- The first letter of every phone number (it can be 10 to 13 digits) should equal "0". If the two first letter is "84", it should be replaced by 0.

For example 0933710850 is ok, 84933710850, "84" will be remove and replace by 0

Actually, I write the code but it has error 1004 and I can not fix it

Sub locso1()
Dim i As Long
Dim j As Long
Dim k As Long

Dim lsrw As Long

Dim arr1()
Dim rearr()

lsrw = Sheet1.[A10000].End(xlUp).Row

 arr1 = Sheet1.Range("B3:AL" & lsrw).Value
ReDim rearr(1 To UBound(arr1, 1), 1 To UBound(arr1, 2))

 
For i = 1 To UBound(arr1, 1)
    For j = 1 To 37
If arr1(i, j) <> "" Then
   If arr1(i, j) Like "[0-9]*" Then
                If Left(Trim(arr1(i, j)), 2) = "84" Then
                    rearr(i, j) = Application.WorksheetFunction.Replace(Trim(arr1(i, j)), 1, 2, "'0")
                    rearr(i, j) = Application.WorksheetFunction.Substitute(Trim(rearr(i, j)), "(", " (")
                 ElseIf Left(Trim(arr1(i, j)), 3) = "'84" Then
                 rearr(i, j) = Application.WorksheetFunction.Replace(Trim(arr1(i, j)), 1, 3, "'0")
                 rearr(i, j) = Application.WorksheetFunction.Substitute(Trim(rearr(i, j)), "(", " (")
                 ElseIf Left(Trim(arr1(i, j)), 2) = "'0" Then
                 rearr(i, j) = Application.WorksheetFunction.Replace(Trim(arr1(i, j)), 1, 2, "'0")
                 rearr(i, j) = Application.WorksheetFunction.Substitute(Trim(rearr(i, j)), "(", " (")
                 ElseIf Left(Trim(arr1(i, j)), 1) = "0" Then
                 rearr(i, j) = Application.WorksheetFunction.Replace(Trim(arr1(i, j)), 1, 1, "'0")
                 rearr(i, j) = Application.WorksheetFunction.Substitute(Trim(rearr(i, j)), "(", " (")
                 Else: rearr(i, j) = arr1(i, j)
                 End If
    ElseIf arr1(i, j) <> "" Then
    rearr(i, j) = arr1(i, j)
    End If
    End If
    Next j
    Next i
    
    For i = 1 To UBound(rearr, 1)
    For j = 1 To 37
        If rearr(i, j) <> "" Then
            For k = j + 1 To UBound(rearr, 2) - 3
            If rearr(i, k) <> "" Then
                If rearr(i, j) = rearr(i, k) Then
                    rearr(i, k) = ""
                End If
            End If
            Next k
        End If
    Next j
    Next i

' Error 1004 Application defined  or object - defined error    
Sheet1.Range("B3").Resize(lsrw - 2, UBound(arr1, 2)).Value = rearr '(error line when row > 1500)

End Sub

Thanks for reading and helping