Transpose bank statement from vertical to horizontal and fill missing gaps

[Gareth Allan]

So here is a function I have not worked with before, but I believe I want to use a transpose function

So I have a set of transactions, listed vertically, in a date then value format, with some dates missed out, some dates multiple values
- to match an old format, I want to list transactions for each day horizontally, and show blank days as well

I am able to do this one 'batch' at a time manually with transpose command, selecting all the lines for a single date, and pasting special to another cell - that's easy peasy

But how do I make it work on a big batch of numbers, and is transpose the best command to use?

I have set up an example, showing two sheets, one as the 'input' and a second sheet as the 'output format'

I can run this on a single sheet if you want, not bothered if we mess up the data or overwrite it - its getting pasted into a blank sheet then copied out anyways
In the output, i would like to include all dates, including gaps with no transactions

total rows so far is around 1000

Any help appreciated

Gareth

[JEC.]

How about

Sub jec()
 Dim jv, ar, a As Variant, i As Long, j As Long
 jv = Sheets("Input Format").Cells(1, 1).CurrentRegion.Value2
 ReDim ar(1000)
   
 With CreateObject("scripting.dictionary")
     For i = jv(1, 1) To jv(UBound(jv), 1)
        For j = 1 To UBound(jv)
           a = .Item(i)
           If IsEmpty(a) Then a = ar
           If i = jv(j, 1) Then
              a(0) = i
              a(1000) = a(1000) + 1
              a(a(1000)) = jv(j, 2)
           End If
          .Item(i) = a
       Next
        If IsEmpty(.Item(i)(0)) Then a = ar: a(0) = i: .Item(i) = a
    Next
    Sheets("Output Format").Cells(8, 1).Resize(.Count, UBound(a)) = Application.Index(.items, 0, 0)
 End With
End Sub

[JEC.]

Another variant

Sub jec()
 Dim jv, dest As Variant, i As Long, j As Long
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 
 jv = Sheets("Input Format").Cells(1, 1).CurrentRegion.Value2
 Set dest = Sheets("Output Format").Cells(8, 1)
 
 With CreateObject("scripting.dictionary")
    For i = jv(1, 1) To jv(UBound(jv), 1)
        For j = 1 To UBound(jv)
           If i = jv(j, 1) Then .Item(i) = .Item(i) & jv(j, 2) & "|"
        Next
       If IsEmpty(.Item(i)) Then .Item(i) = .Item(i)
    Next
    dest.Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
    dest.CurrentRegion.Columns(2).TextToColumns Sheets("Output Format").Range("B8"), 1, , , , , , , 1, "|"
 End With

 Application.DisplayAlerts = True
End Sub

[Gareth Allan]

That is Working for me thank you

Now i just have to go break it down and learn it

Bedankt en goede nacht!

Gareth

[JEC.]

Graag gedaan, van hetzelfde