Trouble sorting and aggregating cell data in excel using VBA

Question

I HAVE UPDATED THIS

Update highlights

Changed part of the code to remove unnecessary commas in the resultant Sheet8.L5 field.
Also implemented the suggestion suggested by feelththis.
Now it just returns "1,9" instead of the desired "1, 9, 29, 37, 50, 61"

Original (slightly changed post)

I am trying to get cell data from three sheets, five cells per sheet for a total of fifteen cells. Remove all zero values. Numerically order the remaining. The insert it into a single cell on another sheet comma delimited. All cell data should contain only positive, whole numbers.

I have provided a sample of what the data looks like and my code below. If there is a better way of approaching this than the way I am attempting I am open to other solutions.

~~The code below does return an error in AggregateSeptember() the line that returns the error has a comment explaining it.~~ Thank you feelththis.

After execution Sheet 8 L5 should = "1, 9, 29, 37, 50, 61"

I am totally stumped by this and haven't written any VB before, I would appreciate any help with this.

Thanks in advance for your time and consideration, Tim

The DATA below is before VBA runs. After the code runs Sheet8.L5.value = "1, 9, 29, 37, 50, 61" as stated above.)

DATA

Sheet 5
M5 N5 O5 P5 Q5 R5
37 0  0  0  0  0

Sheet 6
M5 N5 O5 P5 Q5 R5
1  9  0  0  0  0

Sheet 7
M5 N5 O5 P5 Q5 R5
29 50 61 0  0  0

Sheet 8
L5
0

DATA

Sub AggregateSeptember()

    Dim i As Integer
    Dim j As Integer
    Dim SeptemberTerm1Aggregate As String
    Dim SeptemberTerm1(0 To 14) As Integer
    Dim SeptemberTerm2() As Integer
    Dim SeptemberCols
    SeptemberCols = Array("M5", "N5", "O5", "P5", "Q5")

    For i = 0 To 14
        If i < 5 Then
            If Sheet5.Range(SeptemberCols(i)) <> 0 Then
                SeptemberTerm1(i) = Sheet5.Range(SeptemberCols(i))
            End If
        ElseIf i < 10 Then
            If Sheet6.Range(SeptemberCols(i - 5)) <> 0 Then
                SeptemberTerm1(i - 5) = Sheet6.Range(SeptemberCols(i - 5))
            End If
        ElseIf i < 15 Then
            If Sheet7.Range(SeptemberCols(i - 10)) <> 0 Then
                SeptemberTerm1(i - 10) = Sheet7.Range(SeptemberCols(i - 10))
            End If
        End If
    Next i

    ' This next line no longer returns an error
    SeptemberTerm2 = BubbleSrt(SeptemberTerm1, True)

    For j = 0 To 14
        If SeptemberTerm2(j) > 0 Then SeptemberTerm1Aggregate = SeptemberTerm1Aggregate & SeptemberTerm2(j)
        If j > 0 And j < 14 And SeptemberTerm2(j) > 0 Then SeptemberTerm1Aggregate = SeptemberTerm1Aggregate & ", "
    Next j

    Sheet8.Range("L5").Value = SeptemberTerm1Aggregate

End Sub

Public Function BubbleSrt(ArrayIn, Ascending As Boolean)

    Dim SrtTemp As Variant
    Dim i As Long
    Dim j As Long


    If Ascending = True Then
        For i = LBound(ArrayIn) To UBound(ArrayIn)
             For j = i + 1 To UBound(ArrayIn)
                 If ArrayIn(i) > ArrayIn(j) Then
                     SrtTemp = ArrayIn(j)
                     ArrayIn(j) = ArrayIn(i)
                     ArrayIn(i) = SrtTemp
                 End If
             Next j
         Next i
    Else
        For i = LBound(ArrayIn) To UBound(ArrayIn)
            For j = i + 1 To UBound(ArrayIn)
                If ArrayIn(i) < ArrayIn(j) Then
                    SrtTemp = ArrayIn(j)
                    ArrayIn(j) = ArrayIn(i)
                    ArrayIn(i) = SrtTemp
                End If
            Next j
        Next i
    End If

    BubbleSrt = ArrayIn

End Function

feelthhis · Accepted Answer

Well, it seems you were faster than me, but here's my solution anway. Just change "Sheet1", ..., "Sheet4" to whatever you need.

Sub AggregateSeptember()

    Dim i                   As Integer  ' Counter for Sheets
    Dim j                   As Integer  ' Counter for Columns
    Dim k                   As Integer  ' Counter for your data

    Dim vMySheets           As Variant  ' Sheets
    Dim vSeptemberCols      As Variant  ' Columns
    Dim iCurrent            As Integer  ' Current data
    Dim iSeptemberTerm()    As Integer  ' Data array
    Dim sAggregate          As String   ' Aggregate string

    vMySheets = Array("Sheet1", "Sheet2", "Sheet3")
    vSeptemberCols = Array("M5", "N5", "O5", "P5", "Q5", "R5")
    ReDim iSeptemberTerm(0 To (UBound(vMySheets) + 1) * (UBound(vSeptemberCols) + 1) - 1)

    k = 0
    For i = LBound(vMySheets) To UBound(vMySheets)
        For j = LBound(vSeptemberCols) To UBound(vSeptemberCols)
            iCurrent = ThisWorkbook.Sheets(vMySheets(i)).Range(vSeptemberCols(j)).Value
            If iCurrent <> 0 Then
                iSeptemberTerm(k) = iCurrent
                k = k + 1
            End If
        Next j
    Next i

    ReDim Preserve iSeptemberTerm(0 To k - 1) ' This is just to eliminate the unused elements
    iSeptemberTerm = BubbleSrt(iSeptemberTerm, True)

    For i = LBound(iSeptemberTerm) To UBound(iSeptemberTerm)
        sAggregate = sAggregate & iSeptemberTerm(i) & ", "
    Next i

    sAggregate = Left(sAggregate, Len(sAggregate) - Len(", "))
    ThisWorkbook.Sheets("Sheet4").Range("L5").Value = sAggregate

End Sub

A few notes:

Don't be afraid to throw in new counters, if needed :)
You forgot to put "R5" in SeptemberCols
You can reuse the same counter in other loops (you could use i in your second For)
Note that I was able to make iSeptemberTerm = BubbleSrt(iSeptemberTerm, True) because of how I declared it (without fixed bounds, so that I can dinamically change it)

Trouble sorting and aggregating cell data in excel using VBA

Answers (2)

Related Questions