Search code examples
arraysvbaexcelbubble-sort

Trouble sorting and aggregating cell data in excel using VBA

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
Solution

  • 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)