Sub Macro()
Dim i As Variant
Dim l As Long
Dim p As Long
Dim mySIay() As Variant
Dim DataRange As Range
Dim cell As Range
Dim x As Long
Dim CSico As Long
Dim CTradeID As Long
Dim CBusinessEvent As Long
Dim CNetAmount As Long
Dim CTradeDate As Long
Dim CPaymentDate As Long
Dim CMaturity As Long
Dim CNominal As Long
Dim Label As Variant
Dim ra As Range
Dim T() As Variant
Dim DSum As Double
Dim DSum2 As Double
Dim p2 As Variant
Dim Address As String
l = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
p = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
ps = Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row
Dim CTPY As String
Dim VALUEDATE As Date
Dim Contacts As String
ReDim T(p + 1, 8)
For i = 1 To l
If Cells(1, i).Value = "Value Date" Then VALUEDATE = Cells(2, i).Value
Next i
For i = 1 To l
If Cells(1, i).Value = "Counterparty" Then CTPY = Cells(2, i).Value
Next i
'Primo
Set ra = Cells.Find(What:="Sicovam", LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If ra Is Nothing Then
MsgBox ("Sicovam not found")
Else
Dim SI() As Variant
i = 0
ReDim SI(0)
Range(ra, ra.End(xlDown)).Select
i = 0
For Each cell In Range(ra, ra.End(xlDown))
SI(i) = cell
i = i + 1
ReDim Preserve SI(i)
Next
End If
'Secondo
Set ra = Cells.Find(What:="Trade ID", LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If ra Is Nothing Then
MsgBox ("Trade ID not found")
Else
Dim TI() As Variant
i = 0
ReDim TI(0)
Range(ra, ra.End(xlDown)).Select
i = 0
For Each cell In Range(ra, ra.End(xlDown))
TI(i) = cell
i = i + 1
ReDim Preserve TI(i)
Next
End If
'Terzo
Set ra = Cells.Find(What:="Business Event", LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If ra Is Nothing Then
MsgBox ("Business Event not found")
Else
Dim BE() As Variant
i = 0
ReDim BE(0)
Range(ra, ra.End(xlDown)).Select
i = 0
For Each cell In Range(ra, ra.End(xlDown))
BE(i) = cell
i = i + 1
ReDim Preserve BE(i)
Next
End If
'Quarto
Set ra = Cells.Find(What:="Net Amount", LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If ra Is Nothing Then
MsgBox ("Net Amount not found")
Else
Dim NA() As Variant
i = 0
ReDim NA(0)
Range(ra, ra.End(xlDown)).Select
i = 0
For Each cell In Range(ra, ra.End(xlDown))
NA(i) = cell
i = i + 1
ReDim Preserve NA(i)
Next
End If
'Quinto
Set ra = Cells.Find(What:="Trade Date", LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If ra Is Nothing Then
MsgBox ("Trade Date not found")
Else
Dim TD() As Variant
i = 0
ReDim TD(0)
Range(ra, ra.End(xlDown)).Select
i = 0
For Each cell In Range(ra, ra.End(xlDown))
TD(i) = cell
i = i + 1
ReDim Preserve TD(i)
Next
End If
'Sesto
Set ra = Cells.Find(What:="Payment Date", LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If ra Is Nothing Then
MsgBox ("Payment Date not found")
Else
Dim PD() As Variant
i = 0
ReDim PD(0)
Range(ra, ra.End(xlDown)).Select
i = 0
For Each cell In Range(ra, ra.End(xlDown))
PD(i) = cell
i = i + 1
ReDim Preserve PD(i)
Next
End If
'Settimo
Set ra = Cells.Find(What:="Maturity", LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If ra Is Nothing Then
MsgBox ("Maturity not found")
Else
Dim MA() As Variant
i = 0
ReDim MA(0)
Range(ra, ra.End(xlDown)).Select
i = 0
For Each cell In Range(ra, ra.End(xlDown))
MA(i) = cell
i = i + 1
ReDim Preserve MA(i)
Next
End If
'Ottavo
Set ra = Cells.Find(What:="Nominal", LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If ra Is Nothing Then
MsgBox ("Nominal not found")
Else
Dim NO() As Variant
i = 0
ReDim NO(0)
Range(ra, ra.End(xlDown)).Select
i = 0
For Each cell In Range(ra, ra.End(xlDown))
NO(i) = cell
i = i + 1
ReDim Preserve NO(i)
Next
End If
For i = 0 To p
T(i, 1) = SI(i)
Next i
For i = 0 To p
T(i, 2) = TI(i)
Next i
For i = 0 To p
T(i, 3) = BE(i)
Next i
For i = 0 To p
T(i, 4) = NA(i)
Next i
For i = 0 To p
T(i, 5) = TD(i)
Next i
For i = 0 To p
T(i, 6) = PD(i)
Next i
For i = 0 To p
T(i, 7) = MA(i)
Next i
For i = 0 To p
T(i, 8) = NO(i)
Next i
With Application.WorksheetFunction
DSum = .Sum(.Index(T, 0, 5))
End With
DSum2 = Int(DSum * 100)
DSum = DSum2 / 100
T(p, 4) = DSum
T(p, 0) = "TOTAL"
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
ActiveSheet.Range("B" & p + 1 & ":I" & 2 * p + 1) = T()
ActiveSheet.Range("B" & p + 1 & ":I" & 2 * p + 1).Copy
'For i = 1 To p2
'If Worksheets("Sheet2").Cells(i, 2).Value = CTPY Then Address = Worksheets("Sheet2").Cells(i, 4).Value
'Next i
Address = Application.WorksheetFunction.VLookup(CTPY, _
Worksheets("Sheet2").Range("B:D"), 3, 1)
On Error Resume Next
With OutMail
.to = Address
.CC = ""
.BCC = ""
.Subject = "Amount to confirm Value Date" & " " & VALUEDATE & " " & CTPY
.Body = "Hello, " & vbNewLine & vbNewLine & "Could you confirm the net amount below?" & T(p + 1, 8)
.Attachments.Add ""
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
End Sub