#### gohogs

##### New Member
I'm pretty new to VBA and may be trying to bite off more than I can chew. However, I need to create a procedure that will look at a list stock trades made, then create a .csv file summarizing all the trades. Below is an example:

 Account Action Ticker Shares Account Name 1234-5678 B ge 10 John Smith 1234-5678 B ba 50 John Smith 1234-5678 B wmt 75 John Smith 1234-5678 B amzn 125 John Smith 1234-5678 B goog 50 John Smith 1234-5678 B aaple 75 John Smith 1234-5678 S xom 200 John Smith 1111-2222 S intc 600 William and Mary Baker 1111-2222 S ge 250 William and Mary Baker 1111-2222 S ba 50 William and Mary Baker 1111-2222 B wmt 125 William and Mary Baker 1111-2222 B amzn 25 William and Mary Baker 1111-2222 B goog 200 William and Mary Baker EH 20150612 99999999 B ge 1 20150612 EA 12345678 10 EA 11112222 250 ET 2 260 EH 20150612 99999999 B ba 1 20150612 EA 12345678 50 ET 1 50 EH 20150612 99999999 S ba 1 20150612 EA 11112222 50 ET 1 50

<tbody>
</tbody>

The top shows the trades made in a certain account. The bottom shows a summary of those trades. EH is the header, EA is a listing of each account and the qty, and ET the trailer showing how many accounts and the total. Each unique Security (buys and sells) will have at least these three. EH, EA, and ET. So, GE stock was bought (B for buy) in two accounts - With a total of 260 shares. BA was bought in 1 account for 50 shares. BA was sold (S for sold) in one account for 50 shares, etc.

I'm wanting help thinking about how to break this out into steps, not so much the code for each step. How would you think about the steps for completing this? I'm using Excel 2010.

Please ask questions to clarify - I'm sure I left a bunch of info out.

Thanks!

### Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
I believe this works as you want. Please test on a copy and let me know.

Code:
``````Option Explicit

Dim aryData() As Variant 'Ticker, Action, Account, Shares
Dim lLastInputRow As Long
Dim lInputRowIndex As Long
Dim lOutputRowIndex As Long
Dim sAction As String
Dim sAccount As String
Dim sTicker As String
Dim lShareCount As Long
Dim lArrayIndex As Long
Dim sKey As String
Dim sDateString As String
Dim lTransCount As Long
Dim lUsedRowCount As Long

sDateString = Format(Now(), "yyyymmdd")

'Get last row of input data
lLastInputRow = Range("A1").CurrentRegion.Rows.Count 'Won't count output rows since there is a gap

'Sort Input data
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
Key:=Range("C2:C" & lLastInputRow), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal    'Ticker
Key:=Range("B2:B" & lLastInputRow), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal    'Action
Key:=Range("A2:A" & lLastInputRow), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal    'Account
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:E" & lLastInputRow)
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'Roll up input data
sKey = vbNullString: lShareCount = 0
For lInputRowIndex = 2 To lLastInputRow
If Cells(lInputRowIndex, 1).Value & Cells(lInputRowIndex, 2).Value & Cells(lInputRowIndex, 1).Value <> sKey Then
'Create new row
sKey = Cells(lInputRowIndex, 3).Value & Cells(lInputRowIndex, 2).Value & Cells(lInputRowIndex, 1).Value
lArrayIndex = lArrayIndex + 1
ReDim Preserve aryData(1 To 4, 1 To lArrayIndex)
aryData(1, lArrayIndex) = Cells(lInputRowIndex, 3).Value 'Ticker
aryData(2, lArrayIndex) = Cells(lInputRowIndex, 2).Value 'Action
aryData(3, lArrayIndex) = Cells(lInputRowIndex, 1).Value 'Account
aryData(4, lArrayIndex) = Cells(lInputRowIndex, 4).Value
Else
'Add share count to existing row
aryData(4, lArrayIndex) = aryData(4, lArrayIndex) + CLng(Cells(lInputRowIndex, 4).Value)
End If
Next

'Create output data
lOutputRowIndex = lInputRowIndex + 1
lUsedRowCount = ActiveSheet.UsedRange.Rows.Count
If lOutputRowIndex < lUsedRowCount Then
Range(Cells(lOutputRowIndex, 1), Cells(lUsedRowCount, 1)).EntireRow.Cells.ClearContents
End If
sKey = vbNullString
lTransCount = 0
For lArrayIndex = LBound(aryData, 2) To UBound(aryData, 2)
If aryData(1, lArrayIndex) & aryData(2, lArrayIndex) <> sKey Then
'This is first time for the Ticker/Action combination

If sKey <> vbNullString Then
'If not the first array row processed, write Trailer for previous T/A combo
lOutputRowIndex = lOutputRowIndex + 1
Cells(lOutputRowIndex, 1).Resize(1, 3).Value = _
Array("ET", lTransCount, lShareCount)
lTransCount = 0: lShareCount = 0
End If

lOutputRowIndex = lOutputRowIndex + 1
Cells(lOutputRowIndex, 1).Resize(1, 7).Value = _
Array("EH", sDateString, "99999999", aryData(2, lArrayIndex), aryData(1, lArrayIndex), 1, sDateString)
'Write First Transaction
lOutputRowIndex = lOutputRowIndex + 1
Cells(lOutputRowIndex, 1).Resize(1, 3).Value = _
Array("EA", aryData(3, lArrayIndex), aryData(4, lArrayIndex))
sKey = aryData(1, lArrayIndex) & aryData(2, lArrayIndex)
lTransCount = lTransCount + 1
lShareCount = lShareCount + aryData(4, lArrayIndex)
Else
'Write next transaction for same T/A combo
lOutputRowIndex = lOutputRowIndex + 1
Cells(lOutputRowIndex, 1).Resize(1, 3).Value = _
Array("EA", aryData(3, lArrayIndex), aryData(4, lArrayIndex))
lTransCount = lTransCount + 1
lShareCount = lShareCount + aryData(4, lArrayIndex)
End If

Next

'Write Trailer for last T/A combo
lOutputRowIndex = lOutputRowIndex + 1
Cells(lOutputRowIndex, 1).Resize(1, 3).Value = _
Array("ET", lTransCount, lShareCount)

'Remove dashes from account numbers in output
With Range(Cells(lInputRowIndex + 1, 2), Cells(ActiveSheet.UsedRange.Rows.Count, 2))
.NumberFormat = "@" 'Keep as text.  Don't lose leading zeros
.Replace What:="-", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With

End Sub``````

I believe the example had an error since the input showed ge with a 10 B and 250 S & the output showed 260 B

Replies
3
Views
401
Replies
3
Views
1K
Replies
5
Views
4K

1,196,073
Messages
6,013,267
Members
441,758
Latest member
Abren

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back