Solved

Descending Arrays

Posted on 2007-11-28
6
431 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
PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

 
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

Ransomware: The New Cyber Threat & How to Stop It

This infographic explains ransomware, type of malware that blocks access to your files or your systems and holds them hostage until a ransom is paid. It also examines the different types of ransomware and explains what you can do to thwart this sinister online threat.  

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
Preparing an email is something we should all take special care with – especially when the email is for somebody you may not know very well. The pressures of everyday working life stacked with a hectic office environment can make this a real challen…
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…

688 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