ranges

[Arne Hegefors]

hi! I have a udf that uses a help udf. The main udf reads one or more ranges
and then sorts through them with the us eof the help. it returns a single
value (eg. AA+). The code works just fine but I had to change it because if
the cells that are taking in as argument are not beside each other (ie they
are disjunct ranges) then the code does not work. thus, i tried to solve this
by adding to optional ranges (there can never be more than 3 ranges). But now
the code does not work. So there is something wrong with the ranges in the
beginning but I cannot see where the problem is. please help me! Thanks alot!

Function basel(Rating1 As Range, Optional Rating2 As Range, Optional Rating3
As Range) As String
'Funktionen skapad 2007-04-18 av Anders Rydén
'denna funktion tar fram den rating som skall väljas enligt de Basel-regler
som RB använder.
'Denna funktion använder en hjälpfunktion för att fungera. Hjälpfunktionen
finns nedan.
Dim i As Long
Dim j As Long
Dim k As Long
Dim A() As String
Dim Rating() As String
Dim RatingScale As Variant
Dim MdyRatingScale As Variant

If Rating1 Is Empty Then
For i = 1 To Rating1.Columns.Count
ReDim Preserve Rating(1 To i)
Rating(i) = Rating1(i)
Next
End If

MsgBox "jhv"


If Rating2 Is Not Empty Then
For i = UBound(Rating) To (UBound(Rating) + Rating2.Columns.Count)
ReDim Preserve Rating(i)
Rating(i) = Rating2(i)
Next
End If




RatingScale = Array("AAA", "AA+", "AA", "AA-", "A+", "A", "A-", "BBB+",
"BBB", "BBB-") 'ok SP och Fitch rating
MdyRatingScale = Array("Aaa", "Aa1", "Aa2", "Aa3", "A1", "A2", "A3",
"Baa1", "Baa2", "Baa3") 'ok Moodys rating


i = 1 'räknare för kolumner
j = 1 'räknare för ratingbetyg
k = 0 'räknare för antal celler med godkänd rating
For i = 1 To UBound(Rating) 'kollar varje kolumn för sig
For j = 1 To UBound(RatingScale) 'kollar varje OK rating
If (Rating(i) = RatingScale(j) Or Rating(i) = MdyRatingScale(j))
Then
k = k + 1
ReDim Preserve A(k) 'dimensionera om A
A(k) = j 'de får samma sifferbetyg som i ratingens placering
i arrayen
End If
Next j
Next i

If k <> 0 Then 'om det finns några godkända celler

'här väljs vilken rating som skall användas
'om det endast finns en så skall denna användas
If UBound(A) = 1 Then
basel = RatingScale(A(1))
End If

'om det finns två skall man ta den med lägst
If UBound(A) = 2 Then
If A(1) > A(2) Then
basel = RatingScale(A(1))
Else
basel = RatingScale(A(2))
End If
End If

'om det finns tre eller fler ska man ta de två högsta och om de är
olika den lägsta av dem.
If UBound(A) = 3 Then
SortArray A 'går till funktion som sorterar arrayen
basel = RatingScale(A(2)) 'väljer ut näst högsta i arrayen
End If

ElseIf k = 0 Then 'om det ej finns några godkända celler
basel = "n/a"
End If
End Function

Function SortArray(ByRef TheArray As Variant)
'Skapad av Anders Rydén 2007-04-19
'Detta är en hjälpfunktion till den huvudfunktion som tar fram rärr rating
enligt Basel-reglerna.
'sorterar arrayen efter storlek
Dim Sorted As Boolean
Dim X As Long
Dim B As String
Dim temp
Sorted = False
Do While Not Sorted
Sorted = True
For X = LBound(TheArray) To UBound(TheArray) - 1
If TheArray(X) > TheArray(X + 1) Then
temp = TheArray(X + 1)
TheArray(X + 1) = TheArray(X)
TheArray(X) = temp
Sorted = False
End If
Next X
Loop
End Function

 

[Joel]

I saw your problem yester. It is much clearer now that yuo showed the
program. why don't you use a Union satement to create the ranges ratther
than use an array. go back to your original code that worked. Then create a
new range that is a union of your disjunct cells.

 

[Arne Hegefors]

hi Joel! Thanks alot for your help. I think you are on the right track here.
However I still cannot get it to work. Can you see if I have done something
wrong?

Function basel(Rating1 As Range, Optional Ratings2 As Range, Optional
ratings3 As Range) As String
'Funktionen skapad 2007-04-18 av Anders Rydén
'denna funktion tar fram den rating som skall väljas enligt de Basel-regler
som RB använder.
'Denna funktion använder en hjälpfunktion för att fungera. Hjälpfunktionen
finns nedan.
Dim i As Long
Dim j As Long
Dim k As Long
Dim A() As String
Dim B As String
Dim Ratings As Range
Dim RatingScale As Variant
Dim MdyRatingScale As Variant

Set Ratings = Ratings1

If Ratings2 Is Not Empty Then
Set Ratings = Union(Range("Ratings"), Range("Ratings2"))
End If

If ratings3 Is Not Empty Then
Set Ratings = Union(Range("Ratings"), Range("Ratings3"))
End If

RatingScale = Array("AAA", "AA+", "AA", "AA-", "A+", "A", "A-", "BBB+",
"BBB", "BBB-") 'ok SP och Fitch rating
MdyRatingScale = Array("Aaa", "Aa1", "Aa2", "Aa3", "A1", "A2", "A3",
"Baa1", "Baa2", "Baa3") 'ok Moodys rating


i = 1 'räknare för kolumner
j = 1 'räknare för ratingbetyg
k = 0 'räknare för antal celler med godkänd rating
For i = 1 To Rating.Columns.Count 'kollar varje kolumn för sig
For j = 1 To UBound(RatingScale) 'kollar varje OK rating
If (Rating(i) = RatingScale(j) Or Rating(i) = MdyRatingScale(j))
Then
k = k + 1
ReDim Preserve A(k) 'dimensionera om A
A(k) = j 'de får samma sifferbetyg som i ratingens placering
i arrayen
End If
Next j
Next i

If k <> 0 Then 'om det finns några godkända celler

'här väljs vilken rating som skall användas
'om det endast finns en så skall denna användas
If UBound(A) = 1 Then
basel = RatingScale(A(1))
End If

'om det finns två skall man ta den med lägst
If UBound(A) = 2 Then
If A(1) > A(2) Then
basel = RatingScale(A(1))
Else
basel = RatingScale(A(2))
End If
End If

'om det finns tre eller fler ska man ta de två högsta och om de är
olika den lägsta av dem.
If UBound(A) = 3 Then
SortArray A 'går till funktion som sorterar arrayen
basel = RatingScale(A(2)) 'väljer ut näst högsta i arrayen
End If

ElseIf k = 0 Then 'om det ej finns några godkända celler
basel = "n/a"
End If
End Function

Function SortArray(ByRef TheArray As Variant)
'Skapad av Anders Rydén 2007-04-19
'Detta är en hjälpfunktion till den huvudfunktion som tar fram rärr rating
enligt Basel-reglerna.
'sorterar arrayen efter storlek
Dim Sorted As Boolean
Dim X As Long
Dim B As String
Dim temp
Sorted = False
Do While Not Sorted
Sorted = True
For X = LBound(TheArray) To UBound(TheArray) - 1
If TheArray(X) > TheArray(X + 1) Then
temp = TheArray(X + 1)
TheArray(X + 1) = TheArray(X)
TheArray(X) = temp
Sorted = False
End If
Next X
Loop
End Function

Thanks alot for all your help!!!!!!!

"Joel" skrev:

 

[Joel]

I made some changes to get rid of the errors. Also added a testt driver to
check the code. In some plces you had an S in Ratings1 and other places you
left out the S.

Sub test()
Set Rating1 = Range("A1:C3")
Set Rating2 = Range("D1:F3")

abc = basel(Rating1, Rating2)
End Sub
Function basel(ByVal Ratings1 As Range, Optional ByVal Ratings2 As Range, _
Optional ByVal ratings3 As Range) As String
'Funktionen skapad 2007-04-18 av Anders Rydén
'denna funktion tar fram den rating som skall väljas enligt de Basel-regler
'som RB använder.
'Denna funktion använder en hjälpfunktion för att fungera. Hjälpfunktionen
'finns nedan.
Dim i As Long
Dim j As Long
Dim k As Long
Dim A() As String
Dim B As String
Dim Ratings As Range
Dim RatingScale As Variant
Dim MdyRatingScale As Variant

Set Ratings = Ratings1

If Not Ratings2 Is Nothing Then
Set Ratings = Union(Ratings, Ratings2)
End If

If Not ratings3 Is Nothing Then
Set Ratings = Union(Ratings, ratings3)
End If

RatingScale = Array("AAA", "AA+", "AA", "AA-", "A+", "A", "A-", "BBB+", _
"BBB", "BBB-") 'ok SP och Fitch rating
MdyRatingScale = Array("Aaa", "Aa1", "Aa2", "Aa3", "A1", "A2", "A3", _
"Baa1", "Baa2", "Baa3") 'ok Moodys rating


i = 1 'räknare för kolumner
j = 1 'räknare för ratingbetyg
k = 0 'räknare för antal celler med godkänd rating
For i = 1 To Ratings.Columns.Count 'kollar varje kolumn för sig
For j = 1 To UBound(RatingScale) 'kollar varje OK rating
If (Ratings(i) = RatingScale(j) Or Ratings(i) =
MdyRatingScale(j)) Then
k = k + 1
ReDim Preserve A(k) 'dimensionera om A
A(k) = j 'de får samma sifferbetyg som i ratingens placering
'i arrayen
End If
Next j
Next i

If k <> 0 Then 'om det finns några godkända celler

'här väljs vilken rating som skall användas
'om det endast finns en så skall denna användas
If UBound(A) = 1 Then
basel = RatingScale(A(1))
End If

'om det finns två skall man ta den med lägst
If UBound(A) = 2 Then
If A(1) > A(2) Then
basel = RatingScale(A(1))
Else
basel = RatingScale(A(2))
End If
End If

'om det finns tre eller fler ska man ta de två högsta och om de är
'olika den lägsta av dem.
If UBound(A) = 3 Then
SortArray A 'går till funktion som sorterar arrayen
basel = RatingScale(A(2)) 'väljer ut näst högsta i arrayen
End If

ElseIf k = 0 Then 'om det ej finns några godkända celler
basel = "n/a"
End If
End Function

Function SortArray(ByRef TheArray As Variant)
'Skapad av Anders Rydén 2007-04-19
'Detta är en hjälpfunktion till den huvudfunktion som tar fram rärr rating
'enligt Basel-reglerna.
'sorterar arrayen efter storlek
Dim Sorted As Boolean
Dim X As Long
Dim B As String
Dim temp
Sorted = False
Do While Not Sorted
Sorted = True
For X = LBound(TheArray) To UBound(TheArray) - 1
If TheArray(X) > TheArray(X + 1) Then
temp = TheArray(X + 1)
TheArray(X + 1) = TheArray(X)
TheArray(X) = temp
Sorted = False
End If
Next X
Loop
End Function

 

[Arne Hegefors]

Hi! Thanks Joel! You are really helping me! Now the problem seems to be the
fact that the array A only has Ubound = 1. Somehow only the lowest rating is
shown as basel. It does not matter if it is at the beginning or the end but
Ubound(a) is always equal to 1 and the lowest rating is always shown as
basel. I do not know how that can be. Do you have any idea?

"Joel" skrev:

 

[Joel]

I would try this

For Each cell In Ratings 'kollar varje kolumn för sig
For j = 1 To UBound(RatingScale) 'kollar varje OK rating
stu = UBound(RatingScale)
If (cell = RatingScale(j) Or cell = MdyRatingScale(j)) Then
k = k + 1
ReDim Preserve A(k) 'dimensionera om A
A(k) = j 'de får samma sifferbetyg som i ratingens placering
'i arrayen
End If
Next j
Next Ratings