VBA SPLIT into cells and reshape into table

[johnnyjohn]

Hi Fellas !

I am facing two issues.

1) I am struggling to split a cell that contains multiple lines into arrays.
2) Then, I am trying to shape the arrays into a list-table
[The third step is to create a pivot table from the list, yearly basis (a year starting from the 1st of March).

However, when I apply the Split function, the macro split it once only.

Sub SplitF()

Thisworkbook.Sheet1.Range("C3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("C3"), DataType:=xlFixedWidth, TrailingMinusNumbers:=True

End Sub

And when I am trying to make a loop with For x=1 to Len(Range("C3"))
Nothing happen. I have spent two-days on it. So now, I am kindly asking for your help to give me the right direction.

Thanks a lot !:crying:

What I have



ISIN
Cash Flow


GB0004893086 CORP
07/12/2019 21250 0 07/06/2020 21250 0 07/12/2020 21250 0 07/06/2021 21250 0 07/12/2021 21250 0 07/06/2022 21250 0 07/12/2022 21250 0 07/06/2023 21250 0 07/12/2023 21250 0 07/06/2024 21250 0 07/12/2024 21250 0 07/06/2025 21250 0 07/12/2025 21250 0 07/06/2026 21250 0 07/12/2026 21250 0 07/06/2027 21250 0 07/12/2027 21250 0 07/06/2028 21250 0 07/12/2028 21250 0 07/06/2029 21250 0 07/12/2029 21250 0 07/06/2030 21250 0 07/12/2030 21250 0 07/06/2031 21250 0 07/12/2031 21250 0 07/06/2032 21250 1000000



What I am trying to achieve


ISIN
Date
Coupon
Principal


GB0004893086 CORP
07/12/2019
21250
0


GB0004893086 CORP
07/06/2020
21250
0


GB0004893086 CORP
07/12/2020
21250
0


GB0004893086 CORP
07/06/2021
21250
0


GB0004893086 CORP
07/12/2021
21250
0



25255

[Leith Ross]

Hello johhnyjohn,

Welcome!

This macro will output the table to a sheet named "Results" in the "ideal" format. You do not mention anything about your system. If you are using a Mac, this macro will not work for you. I have added a button to run the macro on "Results".


Sub CreateTable()


Dim CashFlow As String
Dim Cell As Range
Dim DstRng As Range
Dim DstWks As Worksheet
Dim ISIN As Variant
Dim Matches As Object
Dim Output As Variant
Dim RegExp As Object
Dim RngBeg As Range
Dim RngEnd As Range
Dim Row As Long
Dim SrcWks As Worksheet
Dim Text As String

Set DstWks = ThisWorkbook.Worksheets("Results")
Set DstRng = DstWks.Range("B2")

Set SrcWks = ThisWorkbook.Worksheets("Sheet1")
Set RngBeg = SrcWks.Range("B2")

Set RngEnd = SrcWks.Cells(Rows.Count, RngBeg.Column).End(xlUp)

If RngEnd.Row < RngBeg.Row Then
MsgBox "The ISIN Data is Missing.", vbExclamation
Exit Sub
End If

Intersect(DstRng.CurrentRegion, DstRng.CurrentRegion.Offset(1, 0)).ClearContents

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Global = True
RegExp.IgnoreCase = True
RegExp.Pattern = "\d{2}\/\d{2}\/(\d{4})\s(\d+)\s(\d+)\b"

For Each Cell In SrcWks.Range(RngBeg, RngEnd).Cells
ISIN = Cell.Value

If VarType(Evaluate(Cell.Offset(0, 1))) = vbError Then GoTo Skip

Set Matches = RegExp.Execute(Cell.Offset(0, 1).Value)

If Matches.Count > 0 Then
ReDim Output(0 To Matches.Count - 1, 0 To 2)

For cnt = 0 To Matches.Count - 1
With Matches(cnt)
Output(cnt, 0) = CInt(.SubMatches(0))
Output(cnt, 1) = CDbl(.SubMatches(1))
Output(cnt, 2) = CDbl(.SubMatches(2))
End With
Next cnt

DstRng.Resize(Matches.Count, 1).Value = ISIN
DstRng.Offset(0, 1).Resize(Matches.Count, 3).Value = Output
Set DstRng = DstRng.Offset(Matches.Count, 0)
End If

Skip:
Next Cell

End Sub

[YasserKhalil]

Thanks a lot Mr. Leith
Can you explain this part please? as I have tested the code but nothing happened and when using f8 I found that it is skipped because of this part

If VarType(Evaluate(Cell.Offset(0, 1))) = vbError

[Leith Ross]

Hello Yasser,

Of course my friend. It checks if a formula error occurred in the cell. I don't know how the OP is pulling in the data so I added it in just case formulas are being used.

[YasserKhalil]

Thanks a lot. But when I tested the code in the file you attached, it doesn't grab any data .. but when I commented out this line, I could get the results ..
I can't get this part
Evaluate(Cell.Offset(0, 1))

[Leith Ross]

Hello Yasser,

Thanks for catching this problem. I added a check to the code. The error has to be caused by a formula and not just Excel evaluating the cell contents as not a formula.

Here is the corrected code and updated workbook.



Sub CreateTable()


Dim CashFlow As String
Dim Cell As Range
Dim DstRng As Range
Dim DstWks As Worksheet
Dim ErrCheck As Variant
Dim ISIN As Variant
Dim Matches As Object
Dim Output As Variant
Dim RegExp As Object
Dim RngBeg As Range
Dim RngEnd As Range
Dim Row As Long
Dim SrcWks As Worksheet
Dim Text As String

Set DstWks = ThisWorkbook.Worksheets("Results")
Set DstRng = DstWks.Range("B2")

Set SrcWks = ThisWorkbook.Worksheets("Sheet1")
Set RngBeg = SrcWks.Range("B2")

Set RngEnd = SrcWks.Cells(Rows.Count, RngBeg.Column).End(xlUp)

If RngEnd.Row < RngBeg.Row Then
MsgBox "The ISIN Data is Missing.", vbExclamation
Exit Sub
End If

Intersect(DstRng.CurrentRegion, DstRng.CurrentRegion.Offset(1, 0)).ClearContents

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Global = True
RegExp.IgnoreCase = True
RegExp.Pattern = "\d{2}\/\d{2}\/(\d{4})\s(\d+)\s(\d+)\b"

For Each Cell In SrcWks.Range(RngBeg, RngEnd).Cells
ISIN = Cell.Value

ErrCheck = Evaluate(Cell.Offset(0, 1))
If Cell.Offset(0, 1).HasFormula And VarType(ErrCheck) = vbError Then GoTo Skip

Set Matches = RegExp.Execute(Cell.Offset(0, 1).Value)

If Matches.Count > 0 Then
ReDim Output(0 To Matches.Count - 1, 0 To 2)

For cnt = 0 To Matches.Count - 1
With Matches(cnt)
Output(cnt, 0) = CInt(.SubMatches(0))
Output(cnt, 1) = CDbl(.SubMatches(1))
Output(cnt, 2) = CDbl(.SubMatches(2))
End With
Next cnt

DstRng.Resize(Matches.Count, 1).Value = ISIN
DstRng.Offset(0, 1).Resize(Matches.Count, 3).Value = Output
Set DstRng = DstRng.Offset(Matches.Count, 0)
End If

Skip:
Next Cell

End Sub

[YasserKhalil]

Thank you very much Mr. Leith
Best and Kind Regards

[Leith Ross]

Hello Yasser,

You're welcome. Again, thank you for finding that issue with the macro.

سلام

Sìth gun robh maille riut!

[johnnyjohn]

Thank you Leith ! That's working like a charm. You have made it to another level :bow: !
Thanks Yasser too for your contribution. I will change the post as "Solved" but I will keep you up to date when I will reach the "Grand Final" table

[snb]

This seems to be sufficient:

- I deleted the first column in your sample file
- I removed (...) in cell B10 (now A10, since I deleted the first column)
- I added a new sheet 'Sheet2'.


Sub M_snb()
sn = Sheet1.Cells(1).CurrentRegion

For j = 2 To UBound(sn) - 1
st = Split(sn(j, 2))
For jj = 2 To UBound(st) Step 3
If st(jj) <> 0 Then c00 = c00 & vbLf & Year(st(jj - 2)) & "_" & st(jj - 1) & "_" & st(jj)
Next
Next

sp = Split(c00, vbLf)
With Sheet2
.Cells(1).Resize(UBound(sp) + 1) = Application.Transpose(sp)
.Columns(1).TextToColumns , , , , 0, 0, 0, 0, -1, "_"
.Cells(1).Resize(, 3) = Array("Year", "Coupon", "Principal")
.Cells(1).CurrentRegion.Sort .Cells(1), , , , , , , 1
End With
End Sub

I don't show year/coupon combinations that have a zero value

I fear you overlooked the fact that a year can contain data on several coupons.

[johnnyjohn]

Hi snb and thank you for your code.

Actually your code is correct regarding your perspective. And you are completely right when you specified that one year might have several coupons and principals. And this is exactly what I am trying to achieve. Having the total sum of coupons and principals for each year. A year going from 1st of March to 29th of February.

However, I noticed that the code takes only the last date/coupon/principal for each bond, excluding all other date and coupon issued before.

Thank you

John

[johnnyjohn]

Hi Leith Ross,

Thanks again

I adjusted this line :
RegExp.Pattern = "\d{2}\/\d{2}\/(\d{4})\s(\d+)\s(\d+)\b"

with this :
RegExp.Pattern = "\d{2}\/\d{2}\/(\d{4})\s(\d*\.?\d*)\s(\d*\.?\d*)\b"

Instead of to include decimal too and not real numbers only