CODEWITHSUNDEEP
excelvbagraph
Chris H.
Chris H.

Reputation: 325

Secondary axis not graphing values

I have a list of serial numbers with run times that I am trying to graph via a combo graph in excel then push it to PowerPoint. I am using array operations to get the data for the graph, setting up 3 seriescollections and trying to get the serial numbers in a bar chart with counts, then line graphs correlating durations (aveage and total) of run times. The data is getting to the graph, and the values are correct in the select data window. Each series is also assigned the correct axisgroup (primary or secondary) in the graph's select data window. Any ideas why the plotted points for both lines are "0" (double clicking the data point on the graph also says the value is 0)?

I am dim-ing stuff() as variants. I know it's not right. I should either dim them as an arr() of type or arr as variant. IDK why it breaks for me when I do it another way, but it does. I'm also ears abouth that. lol. I appreciate any help!!!!

Code Updated with @FaneDuru's help:

Option Explicit



Public Sub QuickSortArray(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1, _
Optional lngColumn As Long = 0)
    On Error Resume Next
    Dim i As Long
    Dim j As Long
    Dim varMid As Variant
    Dim arrRowTemp As Variant
    Dim lngColTemp As Long
    If IsEmpty(SortArray) Then
        Exit Sub
    End If
    If InStr(TypeName(SortArray), "()") < 1 Then  'IsArray() is somewhat broken: Look for brackets in the type name
        Exit Sub
    End If
    If lngMin = -1 Then
        lngMin = LBound(SortArray, 1)
    End If
    If lngMax = -1 Then
        lngMax = UBound(SortArray, 1)
    End If
    If lngMin >= lngMax Then    ' no sorting required
        Exit Sub
    End If
    i = lngMin
    j = lngMax
    varMid = Empty
    varMid = SortArray((lngMin + lngMax) \ 2, lngColumn)
    ' We  send 'Empty' and invalid data items to the end of the list:
    If IsObject(varMid) Then  ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a valid default member or property
        i = lngMax
        j = lngMin
    ElseIf IsEmpty(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf IsNull(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf varMid = "" Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) = vbError Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) > 17 Then
        i = lngMax
        j = lngMin
    End If
    While i <= j
        While SortArray(i, lngColumn) < varMid And i < lngMax
            i = i + 1
        Wend
        While varMid < SortArray(j, lngColumn) And j > lngMin
            j = j - 1
        Wend
        If i <= j Then
            ' Swap the rows
            ReDim arrRowTemp(LBound(SortArray, 2) To UBound(SortArray, 2))
            For lngColTemp = LBound(SortArray, 2) To UBound(SortArray, 2)
                arrRowTemp(lngColTemp) = SortArray(i, lngColTemp)
                SortArray(i, lngColTemp) = SortArray(j, lngColTemp)
                SortArray(j, lngColTemp) = arrRowTemp(lngColTemp)
            Next lngColTemp
            Erase arrRowTemp
            i = i + 1
            j = j - 1
        End If
    Wend
    If (lngMin < j) Then Call QuickSortArray(SortArray, lngMin, j, lngColumn)
    If (i < lngMax) Then Call QuickSortArray(SortArray, i, lngMax, lngColumn)
End Sub

Private Function contArrayFromDscRng(rng As Range) As Variant 'makes 2D array from a discontinuous range i.e. filtered worksheet
    Dim a As Range, arr, count As Long, i As Long
    
    ReDim arr(1 To rng.Cells.count, 1 To 1): count = 1
    For Each a In rng.Areas
            For i = 1 To a.Cells.count
                arr(count, 1) = a.Cells(i).Value: count = count + 1
            Next
    Next
    contArrayFromDscRng = arr
End Function

Function GetUniqueDict(arr As Variant) As Variant

   Dim dict As Object, i As Long
   Set dict = CreateObject("Scripting.Dictionary")
   
   For i = LBound(arr) To UBound(arr)
        dict(arr(i, 1)) = 1
   Next i
   GetUniqueDict = dict.Keys
End Function

Upvotes: 0

Views: 52

Answers (1)

FaneDuru
FaneDuru

Reputation: 42256

Please, use the next function to build a continuous array from a discontinuous range:

Private Function contArrayFromDscRng(rng As Range) As Variant 'makes 2D array from a discontinuous range
    Dim a As Range, arr, count As Long, i As Long
    
    ReDim arr(1 To rng.cells.count, 1 To 1): count = 1
    For Each a In rng.Areas
            For i = 1 To a.cells.count
                arr(count, 1) = a.cells(i).value: count = count + 1
            Next
    Next
    contArrayFromDscRng = arr
End Function

You can use it in your code as:

serialNum = contArrayFromDscRng(rng)

The next function, will extract an array of unique values from another array:

Function GetUniqueDict(arr As Variant) As Variant
   Dim dict As Object, i As Long
   Set dict = CreateObject("Scripting.Dictionary")
   For i = LBound(arr) To UBound(arr)
        dict(arr(i, 1)) = 1
   Next i
   GetUniqueDict = dict.Keys
End Function

But it will return a 1D array. It can also be used like data sources for a chart.

But if you like your way of processing a 2D array, you can easily transform the returned 1D array. Inside the function, or outside. Something like this:

  Dim arr
  arr = GetUniqueDict(serialNum)
  
  'transform it as a 2D array:
  Dim i As Long
  ReDim serialNum(1 To UBound(arr) + 1, 1 To 1)
  For i = 0 To UBound(arr)
    serialNum(i + 1, 1) = arr(i)
  Next i

Upvotes: 1

Related Questions