Copy data from broken list in a column to a row

Hello all

I'm a total novice at macros and I'm currently working on creating a more efficient reporting process for my team. I work for a bank and am responsible for managing operational risk and processing on options trades.

I have a report where trade details and each trades portfolio number is listed in rows. Each portfolio might have one or more trades and some days we might have some portfolios that might not be there other days. Basically, I need a code that can go down the column to the end of the data and copy the different portfolio numbers into a specified row where a formula under that row will count how many times that number is repeated in that column. Please refer to attached for an idea of what I'm looking for and thanks in advance for your help.

Maurice

Hi jaffermo

Welcome to the Forum.

How many portfolios could there potentially be?
You mention

copy the different portfolio numbers into a specified row

In your sample file that's row 24. Is the specified row 24 or is the specified row "the 3rd row below the end of the data"?
Will the portfolio numbers be in column G and start on row 2?

Hi jaffermo

This code is in the attached and appears to do as you require.

Please note that the code requires you to set a reference to Microsoft Scripting Runtime... Tools > Reference > Microsoft Scripting Runtime

You'll need to think about how to implement...I don't know your process. The code can be adapted to whatever that process is. Let me know of issues.

Option Explicit
Sub FindTotals()
    Dim a As Variant
    Dim LR As Long
    Dim i As Long
    LR = Range("G" & Rows.Count).End(xlUp).Row
    a = Worksheets("Feuil1").Range("G2:G" & LR).Value
    a = UniqueArray(a)
    Range("E" & LR + 3).Resize(1, UBound(a) + 1) = a
    For i = 0 To UBound(a)
        Range("E" & LR + 3).Offset(1, i).Formula = "=countif(G2:G" & LR & "," & Range("E" & LR + 3).Offset(0, i) & ")"
    Next i
    Range("D" & LR + 3).Value = "portfolio:"
    Range("D" & LR + 3).HorizontalAlignment = xlRight
    Range("D" & LR + 4).Value = "# of times repeated:"
    Range("D" & LR + 4).HorizontalAlignment = xlRight
End Sub
 
 
Function UniqueArray(anArray As Variant) As Variant
'Requires, Tools > Reference > Microsoft Scripting Runtime, scrrun.dll
    Dim d As New Scripting.Dictionary, a As Variant
    With d
        .CompareMode = TextCompare
        For Each a In anArray
            If Not Len(a) = 0 And Not .Exists(a) Then
                .Add a, Nothing
            End If
        Next a
        UniqueArray = d.keys
    End With
    Set d = Nothing
End Function

Hi jaffermo

You're welcome...glad I could help. Thanks for the Rep.

If that satisfies your need, I'd appreciate it if you'll please mark your thread as "Solved".
To mark your thread solved do the following:
- Go to your first post on the thread
- Click edit
- Click Advance
- Just below the word "Title:" you will see a dropdown with the word No prefix.
- Change to Solved
- Click Save