If arr(i, 3) <> 0 Then            
For x = 1 To 3
 arr2(lr, x) = arr(i, x)
    Next
    lr = lr + 1
         End If

If arr(i, 3) <> 0 Then            
For x = 1 To 3
 arr2(lr, x) = arr(i, x)
 lr = lr + 1
          Next
         End If

Private Sub CommandButton1_Click()
Dim arr(1 To 9, 1 To 3)
'заполняем первый массив. 1 мера - строки, 2ая - стобцы
For i = LBound(arr, 1) To UBound(arr, 1)
For j = LBound(arr, 2) To UBound(arr, 2)
arr(i, j) = Cells(i, j)
Next
Next
'подготавливаем второй  массив arr_report. 1 мера - строки, 2ая - стобцы
Dim arr_report() 
ReDim arr_report(1 To 4, 1 To 3)
'здесь нужно циклом обойти первый и добавить во второй массив уникальные строки по которым Код<>0


End Sub

Private Sub CommandButton1_Click()
' ВЫВОДИТ JSON В ЯЧЕЙКИ EXCEL
Dim str As Variant, N&, R&
Dim xmlhttp As New MSXML2.XMLHTTP60 ' не забудьте подключить в библиотеках ' tools -> references
Dim URL As String
Dim user As String
Dim password As String

user = Cells(6, "H") 'ячейка для ввода логина
password = Cells(7, "H") 'ячейка для ввода пароля
URL = "http://localhost/json_test/simpleJson.php"  ' путь до страницы ,где выводится json

If user = "" Or password = "" Then
MsgBox "Заполните поля логин и пароль"
Exit Sub
End If

argumentString = "user=" & user & "&password=" & password

        xmlhttp.Open "POST", URL, False ' открываем соединение
        xmlhttp.setRequestHeader "Content-type", "application/x-www-form-urlencoded" '
        xmlhttp.send argumentString
        'MsgBox xmlhttp.responseText, vbInformation, "ЭТО ВЫВОД СЫРОГО JSON НА ЭКРАН! НАЖМИТЕ ОК.
  ' НАЧАЛО ПАРСЕРА
        str = Split(xmlhttp.responseText, "{""client_id"":") 'client_id - имя ключевого поля из таблицы, первое, с чего начинается само тело Json
    N = UBound(str)
    For R = 1 To N
        Cells(R + 1, 1) = Split(Split(str(R), "company_name"":""")(1), """")(0) ' R+1 - выгрузка в ячейки начинается со второй строки
        Cells(R + 1, 2) = Split(Split(str(R), "telefone"":""")(1), """")(0)
        Cells(R + 1, 3) = Split(Split(str(R), "e_mail"":""")(1), """")(0)
    Next R
    ' КОНЕЦ ПАРСЕРА
    
    
Exit Sub
10: MsgBox Err.Description
End Sub

<?php

if (empty($_POST['user']) || empty($_POST['password']))  
{
echo "Заполните поля логин и пароль!";  
} 
else 
{
    $log= $_POST['user'];
    $pass=$_POST['password'];
    
   try {
     $dbh = new PDO('mysql:host=localhost;charset=utf8;dbname=test_db', $log, $pass);
     $response = $dbh->query("SELECT * FROM tbl_clients")->fetchAll(PDO::FETCH_ASSOC);
    
    foreach ($response as $row)
        {
        print json_encode($row,JSON_UNESCAPED_UNICODE);  
        }
} catch (PDOException $e) {
    print "Error!: " . $e->getMessage();
   // die();
}

  }
?>

Private Sub Worksheet_Change(ByVal Target As Range)

Dim GetDateTime
' (+14400 s)
Dim t#
With CreateObject("MSXML2.XMLHTTP" ;) 
.Open "sntp", "http://www.direct-time.ru/track.php?id=time_utc", 0
.send
t = .responseText / 1000
GetDateTime = DateAdd("s", t + 14400, #1/1/1970#)
End With

If Target(1, 1).Column = 1 Then Target(1, 2).Value = GetDateTime 
'где Target(1, 1).Column = 1 изменение ловится в первом столбце
' где Target(1, 2).Value = GetDateTime значение московского времени вставляется во второй
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) 
' а теперь совместим вставку данных московского текущего времени и процедуру изменения ячейки:
 
 Dim GetDateTime
 'Москва (+14400 s)
 Dim t#
 With CreateObject("MSXML2.XMLHTTP" ;)  
 .Open "sntp", "http://www.direct-time.ru/track.php?id=time_utc", 0
 .send
 t = .responseText / 1000
 GetDateTime= DateAdd("s", t + 14400, #1/1/1970#)
 End With

 
 For Each cell in Target 'проходим по всем измененным ячейкам
 If Not Intersect(cell, Range("A2:N1000" ;)  Is Nothing Then 
 With Range("O" & cell.row)
 .Value = GetDateTime
 .EntireColumn.AutoFit 
 End With
 End If
 Next cell
End Sub

Public Function GetDateTime()
 'Москва (+14400 s)
 Dim t#
 With CreateObject("MSXML2.XMLHTTP" ;) 
 .Open "sntp", "http://www.direct-time.ru/track.php?id=time_utc", 0
 .send
 t = .responseText / 1000
 GetDateTime = DateAdd("s", t + 14400, #1/1/1970#)
 End With
End Function