Sub BinanceOrdersHistory()
    Dim x As Object
    Dim Target As ListObject
    Dim listObj As ListObject 'Ïåðåáèðàåò èç òàáëèöû âàëþòíûå ïàðû, è çàãðóçàåò èõ
    Set listObj = ActiveWorkbook.Worksheets("BinanceOrdersHistory").ListObjects("BinanceOH") 'Ïåðåáèðàåò èç òàáëèöû âàëþòíûå ïàðû, è çàãðóçàåò èõ
    Set Target = ActiveWorkbook.Worksheets("BinanceOrdersHistory").ListObjects("BinanceOrdersHistory")
    
    For i = 1 To listObj.ListRows.Count 'Ïåðåáèðàåò èç òàáëèöû âàëþòíûå ïàðû, è çàãðóçàåò èõ
        sym = listObj.ListRows(i).Range().Formula 'Ïåðåáèðàåò èç òàáëèöû âàëþòíûå ïàðû, è çàãðóçàåò èõ
        Set x = BinancePrivate("/api/v3/myTrades", "symbol=" + sym + "&limit=1000")
        For Z = 1 To x.Count
           Set lr = Target.ListRows.Add
            
            For c = 1 To x(1).Count
                If Target.HeaderRowRange(c).Formula = "time" Then 'Ôîðìàòèðîâàíèå âðåìåíè
                    lr.Range(c) = Format(x(Z)(Target.HeaderRowRange(c).Formula) / 86400000# + #1/1/1970#, "general date") 'Ôîðìàòèðîâàíèå âðåìåíè
                Else 'Ôîðìàòèðîâàíèå âðåìåíè
                    lr.Range(c) = x(Z)(Target.HeaderRowRange(c).Formula)
                End If 'Ôîðìàòèðîâàíèå âðåìåíè
            Next c
        Next Z
    Next i 'Ïåðåáèðàåò èç òàáëèöû âàëþòíûå ïàðû, è çàãðóçàåò èõ
    'ActiveWorkbook.Worksheets("BinanceOrdersHistory").Range("BinanceOrdersHistory").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18), Header:=xlYes
Call RemoveDuplicates
End Sub

Sub BinanceOrdersHistory()
    Dim x As Object
    Dim Target As ListObject
    Dim listObj As ListObject
    Set listObj = ActiveWorkbook.Worksheets("BinanceOrdersHistory").ListObjects("BinanceOH")
    Set Target = ActiveWorkbook.Worksheets("BinanceOrdersHistory").ListObjects("BinanceOrdersHistory")
    
    For i = 1 To listObj.ListRows.Count
        sym = listObj.ListRows(i).Range().Formula
        Set x = BinancePrivate("/api/v3/myTrades", "symbol=" + sym + "&limit=1000")
        For Z = 1 To x.Count
           Set lr = Target.ListRows.Add
            
            For c = 1 To x(1).Count
                If Target.HeaderRowRange(c).Formula = "time" Then
                    lr.Range(c) = Format(x(Z)(Target.HeaderRowRange(c).Formula) / 86400000# + #1/1/1970#, "general date")
                Else
                    lr.Range(c) = x(Z)(Target.HeaderRowRange(c).Formula)
                End If
            Next c
        Next Z
    Next i
    ActiveWorkbook.Worksheets("BinanceOrdersHistory").Range("BinanceOrdersHistory").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18), Header:=xlYes
End Sub

Function BtcBid(pair)
    Dim xmlhttp As New MSXML2.XMLHTTP60, myurl As String
    Dim x As Object

    API = "https://btc-trade.com.ua/api/ticker/" + pair
    xmlhttp.Open "GET", API, False
    xmlhttp.Send
    Set x = ParseJson(xmlhttp.responseText)
    Set xmlhttp = Nothing
    
    BtcBid = val(x(pair)("buy"))
End Function

Public Sub DeleteDuplicateRows()
' This macro will delete all duplicate rows which reside under
' the first occurrence of the row.
'
'Use the macro by selecting a column to check for duplicates
'and then run the macro and all duplicates will be deleted, leaving
'the first occurrence only.

Dim R As Long
Dim N As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo EndMacro

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set Rng = Application.Intersect(ActiveSheet.UsedRange, _
                    ActiveSheet.Columns(ActiveCell.Column))

Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0")

N = 0

For R = Rng.Rows.Count To 2 Step -1

    If R Mod 500 = 0 Then
    
        Application.StatusBar = "Processing Row: " & Format(R, "#,##0")
    
    End If
    
    V = Rng.Cells(R, 1).Value
    
    If V = vbNullString Then
    
        If Application.WorksheetFunction.CountIf(Rng.Columns(1), vbNullString) > 1 Then
    
            Rng.Rows(R).EntireRow.Delete
    
            N = N + 1
    
        End If
    
    Else
    
        If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
    
            Rng.Rows(R).EntireRow.Delete
    
            N = N + 1
    
        End If
    
    End If

Next R

EndMacro:

Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Duplicate Rows Deleted: " & CStr(N)

End Sub

Sub B()
    Dim x As Object
    Dim Target As ListObject
    Set Target = ActiveWorkbook.Worksheets("B").ListObjects("B")
    
        Set x = BP("/sapi/history", "s=" + sym + "&limit=1000")
        For Z = 1 To x.Count
           Set lr = Target.ListRows.Add
            
            For c = 1 To x(1).Count
            
                    lr.Range(c) = x(Z)(Target.HeaderRowRange(c).Formula)
            Next c
        Next Z
    ActiveWorkbook.Worksheets("B").Range("B").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9), Header:=xlYes
End Sub

Sub Extract_Unique()
    Dim vItem, avArr, li As Long
    ReDim avArr(1 To Rows.Count, 1 To 1)
    With New Collection
        On Error Resume Next
        For Each vItem In Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value
            'Cells(Rows.Count, 1).End(xlUp) – определяет последнюю заполненную ячейку в столбце А
            .Add vItem, CStr(vItem)
            If Err = 0 Then
                li = li + 1: avArr(li, 1) = vItem
            Else: Err.Clear
            End If
        Next
    End With
    If li Then [E2].Resize(li).Value = avArr
End Sub