Solved

Descending Arrays

Posted on 2007-11-28
6
425 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
Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

 
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

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
database opened as read only 10 32
SQL Select in Access 2003 3 26
Gracefully handling 'Record Locked'  Errors 33 35
Question about formatting a report 11 19
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…
In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

861 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