Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Descending Arrays

Posted on 2007-11-28
6
Medium Priority
?
445 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
  • 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 2000 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

Instead of error trapping or hard-coding for non-updateable fields when using QODBC, let VBA automatically disable them when forms open. This way, users can view but not change the data. Part 1 explained how to use schema tables to do this. Part 2 h…
Sometimes MS breaks things just for fun... In Access 2003, only the maximum allowable SQL string length could cause problems as you built a recordset. Now, when using string data in a WHERE clause, the 'identifier' maximum is 128 characters. So, …
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…

564 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