For i = LBound(arr) To UBound(arr)
     For j = LBound(arr4) To UBound(arr4)
        n = InStr(arr4(j), " ")
          If Val(Left(arr4(j), n)) = arr(i, 1) And InStr(arr4(j), "PR No.") <> 0 Then
             k = j + 1
             For ind = k To UBound(arr4)
               If InStr(arr4(ind), "PR No.") <> 0 And Val(Left(arr4(ind), n)) = arr(i, 1) + 10 Then
                 li = ind - 1
               Exit For
               Else
                li = UBound(arr4)
               End If
              Next
                ReDim arr2(k To li)
                    For x = k To li
                      arr2(x) = arr4(x)
                    Next
                Dim a
                a = Join(arr2, Chr(10))
                Dim n1&, n2&
                n1 = InStr(1, a, " ")
                n2 = InStr(n1 + 1, a, " ")
                arr(i, 6) = Trim(Left(a, n1))
                If Trim(Mid(a, n1, n2 - n1)) = "EA" Then
                arr(i, 7) = "Each"
                ElseIf Trim(Mid(a, n1, n2 - n1)) = "M" Then
                arr(i, 7) = "Meter"
                Else
                arr(i, 7) = Trim(Mid(a, n1, n2 - n1))
                End If
                arr(i, 4) = arr(i, 3) & Chr(10) & Trim(Mid(a, n2))
                arr(i, 3) = arr(i, 4)
            End If
        Next
    Next