# Sorting and summation of a spreadsheet

I am working on a sorted data file, so there does not need to be any sorting logic. I find unique values, feed them into an array, then use the worksheetfunction.sum to get totals for a field.

Is this as efficient as I could be, or are there some things I'm not seeing and should?

The "Items" sheet is where a number of accounts are stored (in the thousands). The user cuts and pastes the data from another spreadsheet It is sorted by account, and each line all the columns are identical except for the totals, and the first coloumn which contains the account number.

I collect an array of account numbers, then cycle through the array to find the first instance, and continue down until I find the last instance. Populate a second array with the contents of all cells in that row (up to the last column with a header, then get a sum of the totals, and overwrite that element of the array.

When completed, I drop the entire array made from the items sheet into the summary sheet.

Option Explicit

Sub makeSummary()

Dim inws As Worksheet
Dim outws As Worksheet

Dim fndRange As Range
Dim zell As Range

Dim firstRow As Integer
Dim lastRow As Integer
Dim colctr As Integer
Dim totalCol As Integer
Dim LastCol As Integer

Dim ctr As Long
Dim arrBound As Long

Dim distVals() As String
Dim newRows() As String

' Initialize variables
Set inws = Sheets("Items")
Set outws = Sheets("Summary_Sheet")
outws.Cells.Clear
Set fndRange = Range(GetLast(3, inws.Cells))
LastCol = fndRange.Column
lastRow = fndRange.Row
Set fndRange = Nothing

'populate the header columns in the output worksheet.
For ctr = 1 To LastCol
outws.Cells(1, ctr) = inws.Cells(1, ctr).Value
Next ctr

' redim array, and populate with unique SFC values
ReDim distVals(1)
distVals(1) = inws.Cells(2, 1)
For ctr = 2 To lastRow
If inws.Cells(ctr, 1).Value <> distVals(UBound(distVals)) Then
ReDim Preserve distVals(UBound(distVals) + 1)
distVals(UBound(distVals)) = inws.Cells(ctr, 1).Value
End If
Next ctr

'Get upper bound of search array and use it to set max row value of newrows array
arrBound = UBound(distVals)
ReDim newRows(1 To arrBound, 1 To LastCol)

'build array,
For ctr = 1 To arrBound
Set fndRange = inws.Cells.Find(distVals(ctr), lookat:=xlPart, LookIn:=xlFormulas)
firstRow = fndRange.Row
lastRow = fndRange.Row
Do Until inws.Cells(lastRow + 1, 1) <> distVals(ctr)
lastRow = lastRow + 1
Loop
'fill row
For colctr = 1 To LastCol
newRows(ctr, colctr) = inws.Cells(firstRow, colctr)
Next colctr
'Get total of totals in SFC
newRows(ctr, 5) = WorksheetFunction.Sum(Range(inws.Cells(firstRow, 5), inws.Cells(lastRow, 5)))
Next ctr

'clean up of destination sheet
With outws
.Columns("E").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_(\$* ""-""??_);_(@_)"
'excel doesn't recognize the numbers as numbers unless you multiply by 1 and drop the value back down.
zell.Value = zell.Value * 1
Next zell
.Calculate
End With

End Sub

Function GetLast(choice As Long, rng As Range)
' 1 = GetLast row
' 2 = GetLast column
' 3 = GetLast cell

Dim ReturnRng As Range

Set ReturnRng = rng.Find(What:="*", After:=rng.Cells(1), lookat:=xlPart, LookIn:=xlFormulas, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)

If Not ReturnRng Is Nothing Then
With ReturnRng
Select Case choice
Case 1
GetLast = .Row
Case 2
GetLast = .Column
Case 3
Case Else
End Select
End With
End If
End Function

• Almost, I provided you with the finishing touch. Welcome to Code Review :-) – Mast Sep 29 '16 at 15:30
• Hey Richard, can you expand a bit on the context of your work. What is your data, where does it come from, where does it go to, what is the outcome you're trying to achieve? The more we know about what your requirements and constraints are, the better we can tailor advice to your specific situation. – Kaz Sep 29 '16 at 15:33
• If I'm understanding correctly, you could just create a dictionary of account numbers and use it to find totals for each unique entry in the dictionary, yes? – Raystafarian Oct 3 '16 at 18:29
• @Raystafarian I'll give that a try, thank you. – Don Thermidor_Lobster Mobster Oct 3 '16 at 18:48
• If I did understand correctly, I provided an example below. If I misunderstood - apologies! – Raystafarian Oct 3 '16 at 20:31

### Quick Things

First, it's good practice to indent all of your code that way Labels will stick out as obvious.

Second, Worksheets have a CodeName property - View Properties window (F4) and the (Name) field (the one at the top) can be used as the worksheet name. This way you can avoid Dim inws as Worksheet, set inws = Sheets"Items" and instead just use Items.

Comments - "code tell you how, comments tell you why". The code should speak for itself, if it needs a comment, it might need to be made more clear. If not, the comment should describe why you're doing something rather than how you're doing it. Here are a few reasons to avoid comments all together.

Integers - integers are obsolete. According to msdn VBA silently converts all integers to long.

### Naming

Your variable names leave a lot to be desired. It's pretty easy to use descriptive names and characters are mostly free, so things like

ctr = columnCounter or rowCounter or even just counter.

Also, Standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names. So inws should be inWS or inWorksheet or sourceWorksheet.

Right now things like zell and distVals don't really tell me anything at all about what I should be expecting them to do.

### Function

Function GetLast - it's your prerogative, but I think it's unneeded. If you did want you keep it, it would be better as

Private Function GetLast(ByVal choice as Long, ByVal rng as Range) as Long


Right now you're passing ByRef, which isn't best practice and you don't have a return type defined. You can return a row number, column number or address (string?). That can lead to errors down the line if you change what you're looking for and expect the wrong type back. Personally,

Dim lastRow As Long
lastRow = Sheet.Cells(Rows.Count, 1).End(xlUp).Row
Dim lastColumn As Long
lastColumn = Sheet.Cells(1, Columns.Count).End(xlToLeft).Column


Would work fine for me. And you could eliminate all of

Set fndRange = Range(GetLast(3, inws.Cells))
LastCol = fndRange.Column
lastRow = fndRange.Row
Set fndRange = Nothing


### Arrays

Dim distVals() As String
Dim newRows() As String
ReDim distVals(1)
distVals(1) = inws.Cells(2, 1)
For ctr = 2 To lastRow
If inws.Cells(ctr, 1).Value <> distVals(UBound(distVals)) Then
ReDim Preserve distVals(UBound(distVals) + 1)
distVals(UBound(distVals)) = inws.Cells(ctr, 1).Value
End If
Next ctr

'Get upper bound of search array and use it to set max row value of newrows array
arrBound = UBound(distVals)
ReDim newRows(1 To arrBound, 1 To LastCol)


I think what's happening here is that you initialize the array, then populate it one cell at a time, assuming that your data is in some sort of order because you're checking only the last element for duplicates, right? That is a lot of redimming and isn't needed. A dictionary could help with that by eliminating duplicates for you

Dim valueDictionary As Object
Set valueDictionary = CreateObject("Scripting.Dictionary")
For counter = 2 To lastRow
valueDictionary(Cells(counter, 2).Value) = 1
Next


Now arrBound = UBound(distVals) is just valueDictionary.Count

Now, your newRows array is a little confusing to me. Why not just build an array, maybe like this -

    Dim mySummedArray As Variant
ReDim mySummedArray(1 To valueDictionary.Count, 1 To 2)
ReDim arr(1 To valueDictionary.Count, 1 To 2)
counter = 1
Dim key As Variant
For Each key In valueDictionary.keys
mySummedArray(i, 1) = key
i = i + 1
Next
For counter = 1 To valueDictionary.Count
mySummedArray(counter, 1) = valueDictionary.keys(counter)
Next
Dim indexValue As String
Dim arrayIndex As Long
For counter = 1 To lastRow
indexValue = Cells(counter, 1)
arrayIndex = FindInArray(indexValue, mySummedArray)
mySummedArray(arrayIndex, 2) = mySummedArray(arrayIndex, 2) + Cells(counter, 2)
Next


Using

Private Function FindInArray(ByVal indexValue As String, ByVal arrayToSearch As Variant) As Long
Dim i As Long
For i = LBound(arrayToSearch) To UBound(arrayToSearch)
If StrComp(indexValue, arrayToSearch(i, 1), vbTextCompare) = 0 Then
FindInArray = i
Exit For
End If
Next
End Function


Essentially you end up with a 2D array of unique values paired with their sum. But maybe that's not what you're doing? If not, sorry, but maybe the approach is still useful.