Solved

Descending Arrays

Posted on 2007-11-28
6
421 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 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
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
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

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

The first two articles in this short series — Using a Criteria Form to Filter Records (http://www.experts-exchange.com/A_6069.html) and Building a Custom Filter (http://www.experts-exchange.com/A_6070.html) — discuss in some detail how a form can be…
I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
Familiarize people with the process of utilizing SQL Server stored procedures from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Micr…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

760 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now