Public Function GetBR(ByVal CurrencyName As String, Optional ByVal d As Date) As Double
     Dim sURL As String
     If d = 0 Then d = Now()
     sURL = "https://www.nbrb.by/services/xmlexrates.aspx?ondate=" & Format(d, "mm/dd/yyyy")
     Dim oXMLHTTP
     On Error Resume Next
     Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
     With oXMLHTTP
        .Open "GET", sURL, False
        .send
        k = Split(Split(.responseText, CurrencyName & "</CharCode>")(1), "</Rate>")(0)
        'MsgBox Split(Split(k, "Rate>")(1), "<")(0)
        GetBR = Val(Split(Split(k, "Rate>")(1), "<")(0))
     End With
     Set oXMLHTTP = Nothing
End Function

Function NBNew(ByVal Cur As String, Optional ByVal OnDate As Date) As Double
If OnDate = 0 Then OnDate = Date
  Static oDoc As Object
  If oDoc Is Nothing Then
    Set oDoc = CreateObject("msxml2.DOMDocument")
    oDoc.async = False
  End If
  If IsMissing(OnDate) Then OnDate = Date
  oDoc.Load "https://www.nbrb.by/services/xmlexrates.aspx?ondate=" & Format(OnDate, "mm/dd/yyyy")
  With oDoc.SelectSingleNode("//Currency[CharCode='" & UCase(Cur) & "']")
    NBNew = Val(Replace(.SelectSingleNode("Rate").Text, ",", "."))
  End With
End Function

 Public Function GetBR2(ByVal CurrencyName As String, Optional ByVal d As Date) As Double
     Dim sURL As String
     If d = 0 Then d = Now()
     sURL = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" & Format(d, "dd\/mm\/yyyy")
     Dim oXMLHTTP
     On Error Resume Next
     Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
     With oXMLHTTP
        .Open "GET", sURL, False
        .send
        k = Split(Split(.responseText, CurrencyName & "</CharCode>")(1), "</Value>")(0)
        'MsgBox Split(Split(k, "Value>")(1), "<")(0)
        GetBR2 = Split(Split(k, "Value>")(1), "<")(0) / Split(Split(k, "Nominal>")(1), "<")(0)
     End With
     Set oXMLHTTP = Nothing
End Function

Function CbrNew(ByVal Cur As String, Optional ByVal OnDate As Date) As Double
If OnDate = 0 Then OnDate = Date
  Static oDoc As Object
  If oDoc Is Nothing Then
    Set oDoc = CreateObject("msxml2.DOMDocument")
    oDoc.async = False
  End If
  If IsMissing(OnDate) Then OnDate = Date
  oDoc.Load "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" & Format(OnDate, "DD\/MM\/YYYY")
  With oDoc.SelectSingleNode("//Valute[CharCode='" & UCase(Cur) & "']")
    CbrNew = Val(Replace(.SelectSingleNode("Value").Text, ",", ".")) / Val(.SelectSingleNode("Nominal").Text)
  End With
End Function

 Public Function GetBR(ByVal CurrencyName As String, Optional ByVal d As Date) As Double
     Dim sURL As String
     If d = 0 Then d = Now()
     sURL = "https://www.nbrb.by/services/xmlexrates.aspx?ondate=" & Format(d, "mm/dd/yyyy")
     Dim oXMLHTTP
     On Error Resume Next
     Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
     With oXMLHTTP
        .Open "GET", sURL, False
        .send
        k = Split(Split(.responseText, CurrencyName & "</Name>")(1), "</Rate>")(0)
        GetBR = Val(Right(k, Len(k) - InStr(1, k, ">")))
     End With
     Set oXMLHTTP = Nothing
End Function

=СУММПРОИЗВ(СЧЁТЕСЛИМН(J3:J5;E17:G17;K3:K5;1)*СЧЁТЕСЛИМН(J8:J9;A18:A42;K8:K9;1)*(B18:B42=J11)*(C18:C42=J12);E18:G42)

=SUMPRODUCT($B$2:C2;$B$3:C3)*D8+D2*D3*$B$8

Sub DeleteEmptySpace()
    LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    LastClm = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
    Application.ScreenUpdating = False
    For R = LastRow To 1 Step -1
        If Application.CountA(Rows(R)) = 0 Then Rows(R).Delete
    Next R
    For N = LastClm To 1 Step -1
        If Application.CountA(Columns(N)) = 0 Then Columns(N).Delete
    Next N
End Sub

или так

Sub DeleteEmptyRows()
Dim i&, LastRow&, LastCol&
With ActiveSheet.UsedRange
    LastRow = .Row - 1 + .Rows.Count
    LastCol = .Column - 1 + .Columns.Count
End With
Application.ScreenUpdating = False
For R = LastRow To 1 Step -1
    If Application.CountA(Rows(R)) = 0 Then Rows(R).Delete
Next R
For N = LastCol To 1 Step -1
    If Application.CountA(Columns(N)) = 0 Then Columns(N).Delete
Next N
End Sub
 

'If IsEmpty(rInt) Then
'Me.Range("p" & cell.Row).Value = ""
'Else
'End If

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rInt As Range, rCel As Range
 lRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
Set rInt = Union(Range("g10:h" & lRow), Range("j10:j" & lRow))
    For Each cell In Target   'проходим по всем измененным ячейкам
       If Not Intersect(Target, rInt) Is Nothing Then
            'If IsEmpty(rInt) Then
                 'Me.Range("p" & cell.Row).Value = ""
            'Else
                With Me.Range("p" & cell.Row)
                    .Value = Now
                    .NumberFormat = "dd.mm.yyyy hh:mm:ss"
                    .EntireColumn.AutoFit
                End With
            'End If
       End If
    Next cell
End Sub