Solved

Descending Arrays

Posted on 2007-11-28
6
429 Views
Last Modified: 2010-04-21
I am using this code to populate a matrix. All was working well until they decided that they needed to specify the labels as descending or ascending. Example:
    1    2   3   4   5
A
B
C
D
E

might need to be
   5   4   3  2  1
E
D
C
B
A

easy enough, except the row and column count is not always the same. i thoguht i had this code right, but it is throwing me an error (subscript out of range). i've been looking at it too long, i need some help before my head explodes.

-a


Function PopulateMatrix()
 
Dim aRoman, aRomanD, aAlpha, aAlphaD, aNumD, aPS, aRC
 
'Define arrays
aRoman = Array("I", "II", "III", "IV", "V", "VI")
aRomanD = Array("VI", "V", "IV", "III", "II", "I")
aAlpha = Array("A", "B", "C", "D", "E", "F")
aAlphaD = Array("F", "E", "D", "C", "B", "A")
aNumD = Array(6, 5, 4, 3, 2, 1)
aPS = Array("Prob", "Sev")
aRC = Array("Row", "Col")
    
    'Prevent user from selecting Roman Numerals for both axis
    If Me.Controls("frm" & aPS(0) & "Format") = 1 Then 'Roman Numerals
        If Me.Controls("frm" & aPS(1) & "Format") = 1 Then 'Roman Numerals
        MsgBox "You cannot use Roman Numerals for both Severity and Probability", _
                    vbOKOnly
        Me.Controls("frm" & aPS(0) & "Format") = 3
        End If
    End If
 
'Changes captions to array values correlated with user selection
For j = 0 To 1
    For i = 1 To 6
        Select Case Me.Controls("frm" & Trim(CStr(aPS(j))) & "Format")
            Case Is = 1
                Select Case Me.Controls("frmOrder" & j)
                    Case Is = 1: Me.Controls("lbl" & aPS(j) & i).Caption = aRoman(i - 1)
                    Case Is = 2: Me.Controls("lbl" & aPS(j) & i).Caption = _
                        aRomanD((i - 1) + (6 - Me.Controls("cmb" & aRC(j) & "Qty").Value))
                End Select
            Case Is = 2
                Select Case Me.Controls("frmOrder" & j)
                    Case Is = 1: Me.Controls("lbl" & aPS(j) & i).Caption = i
                    Case Is = 2: Me.Controls("lbl" & aPS(j) & i).Caption = _
                        aNumD((i - 1) + (6 - Me.Controls("cmb" & aRC(j) & "Qty").Value))
                End Select
            Case Is = 3
                Select Case Me.Controls("frmOrder" & j)
                    Case Is = 1: Me.Controls("lbl" & aPS(j) & i).Caption = aAlpha(i - 1)
                    Case Is = 2: Me.Controls("lbl" & aPS(j) & i).Caption = _
                        aAlphaD((i - 1) + (6 - Me.Controls("cmb" & aRC(j) & "Qty").Value))
                End Select
        End Select
    Next
Next
 
'Changes matrix values to concatenation of x & y axis labels
    For i = 1 To 6
      For j = 1 To 6
        Me.Controls("txtP" & i & "s" & j) = Me.Controls("lblSev" & i).Caption & _
                Me.Controls("lblProb" & j).Caption
       Next
    Next
 
End Function

Open in new window

0
Comment
Question by:adraughn
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
6 Comments
 
LVL 13

Author Comment

by:adraughn
ID: 20368129
c'mon dwyer, where are you when i need you?
0
 
LVL 10

Accepted Solution

by:
aesmike earned 500 total points
ID: 20371836
I hate it when my head explodes....
Ok, not sure this will work 'cause I don't have your app.  I rewrote it a little bit differently but same effect.
Private Sub PopulateMatrix()
    Dim aRoman, aAlpha, aNumeric
    Dim aArrayToUse
    
    Dim aPS, aRC
    Dim iStart, iStop, iDir
    Dim j, i, c
    Dim iMatrixDimension
    
    Const MaxElements = 6
    
    
    
    aPS = Array("Prob", "Sev")
    aRC = Array("Row", "Col")
    
    aRoman = Array("I", "II", "III", "IV", "V", "VI")
    aAlpha = Array("A", "B", "C", "D", "E", "F")
    aNumeric = Array("1", "2", "3", "4", "5", "6")
    
    'Prevent user from selecting Roman Numerals for both axis
    If Me.Controls("frm" & aPS(0) & "Format") = 1 Then 'Roman Numerals
        If Me.Controls("frm" & aPS(1) & "Format") = 1 Then 'Roman Numerals
        MsgBox "You cannot use Roman Numerals for both Severity and Probability", _
                    vbOKOnly
        Me.Controls("frm" & aPS(0) & "Format") = 3
        End If
    End If
    
    
    'first clear out all the columns/row labels
    For j = 0 To 1
        For c = 1 To MaxElements
            Me.Controls("lbl" & CStr(aPS(j)) & c).Caption = ""
        Next
    Next
    
    
    'loop through both dimensions (row/col)
    For j = 0 To 1
        'pick the array of labels we want to use
        Select Case Me.Controls("frm" & Trim(CStr(aPS(j))) & "Format")
            Case 1
                aArrayToUse = aRoman
            Case 2
                aArrayToUse = aNumeric
            Case 3
                aArrayToUse = aAlpha
        End Select
        
        'determine the positions within the array we want to use
        iMatrixDimension = Val(Nz(Me.Controls("cmb" & aRC(j) & "Qty")))
        iDir = IIf(Me.Controls("frmOrder" & j) = 1, 1, -1)  'this is the direction to go: -1 means descending, +1 means ascending
        iStart = IIf(iDir = 1, 0, iMatrixDimension - 1)
        iStop = iStart + ((iMatrixDimension - 1) * iDir)
        
        'now loop through array and set the captions
        c = 0 'c is a counter that points to the column or row we are setting
        For i = iStart To iStop Step iDir
            c = c + 1
            Me.Controls("lbl" & Trim(CStr(aPS(j))) & c).Caption = aArrayToUse(i)
        Next
            
    Next
    
    'Changes matrix values to concatenation of x & y axis labels
    For i = 1 To 6
      For j = 1 To 6
        Me.Controls("txtP" & i & "s" & j) = Me.Controls("lblSev" & i).Caption & _
                Me.Controls("lblProb" & j).Caption
       Next
    Next
    
    
 
End Sub

Open in new window

0
 
LVL 13

Author Comment

by:adraughn
ID: 20374250
I did finally fix it last night at starbucks, but I am going to compare your code and will let you know if it works.

thanks sweetie.

-a
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 13

Author Comment

by:adraughn
ID: 20374644
This is what I had come up with:

Function PopulateMatrix()

Dim aRoman, aRomanD, aAlpha, aAlphaD, aNumD, aPS, aRC

'Define arrays
aRoman = Array("I", "II", "III", "IV", "V", "VI")
aRomanD = Array("VI", "V", "IV", "III", "II", "I")
aAlpha = Array("A", "B", "C", "D", "E", "F")
aAlphaD = Array("F", "E", "D", "C", "B", "A")
aNumD = Array(6, 5, 4, 3, 2, 1)
aPS = Array("Prob", "Sev")
aRC = Array("Row", "Col")
   
    'Prevent user from selecting Roman Numerals for both axis
    If Me.Controls("frm" & aPS(0) & "Format") = 1 Then 'Roman Numerals
        If Me.Controls("frm" & aPS(1) & "Format") = 1 Then 'Roman Numerals
        MsgBox "You cannot use Roman Numerals for both Severity and Probability", _
                    vbOKOnly
        Me.Controls("frm" & aPS(0) & "Format") = 3
        End If
    End If

'Changes captions to array values correlated with user selection
For j = 0 To 1
    For i = 1 To Me.Controls("cmb" & aRC(j) & "Qty").Value
        Select Case Me.Controls("frm" & Trim(CStr(aPS(j))) & "Format")
            Case Is = 1
                Select Case Me.Controls("frmOrder" & j)
                    Case Is = 1: Me.Controls("lbl" & aPS(j) & i).Caption = aRoman(i - 1)
                    Case Is = 2: Me.Controls("lbl" & aPS(j) & i).Caption = _
                        aRomanD((i - 1) + (6 - Me.Controls("cmb" & aRC(j) & "Qty").Value))
                End Select
            Case Is = 2
                Select Case Me.Controls("frmOrder" & j)
                    Case Is = 1: Me.Controls("lbl" & aPS(j) & i).Caption = i
                    Case Is = 2: Me.Controls("lbl" & aPS(j) & i).Caption = _
                        aNumD((i - 1) + (6 - Me.Controls("cmb" & aRC(j) & "Qty").Value))
                End Select
            Case Is = 3
                Select Case Me.Controls("frmOrder" & j)
                    Case Is = 1: Me.Controls("lbl" & aPS(j) & i).Caption = aAlpha(i - 1)
                    Case Is = 2: Me.Controls("lbl" & aPS(j) & i).Caption = _
                        aAlphaD((i - 1) + (6 - Me.Controls("cmb" & aRC(j) & "Qty").Value))
                End Select
        End Select
    Next
Next

'Changes matrix values to concatenation of x & y axis labels
    For i = 1 To 6
      For j = 1 To 6
        Me.Controls("txtP" & i & "s" & j) = Me.Controls("lblSev" & j).Caption & _
                Me.Controls("lblProb" & i).Caption
       Next
    Next
 
End Function
0
 
LVL 13

Author Comment

by:adraughn
ID: 20374696
my hero. works great.

-a
0
 
LVL 13

Author Closing Comment

by:adraughn
ID: 31411502
you rock
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

As tax season makes its return, so does the increase in cyber crime and tax refund phishing that comes with it
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
Familiarize people with the process of retrieving data from SQL Server using an Access pass-thru query. Microsoft Access is a very powerful client/server development tool. One of the ways that you can retrieve data from a SQL Server is by using a pa…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

726 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question