Run-time error '9': Subscript out of range

[ddub25]

Can anyone suggest why the following code is returning an error: "Run-time error '9': Subscript out of range" ? I have highlighted in RED, the code that is causing the problem - it is this part: Range("P" & i).Value = arr(j, 1)

Any help would be appreciated.


Sub STR_UPu2_2_H()

' Declare variables
Dim i As Long, j As Long, n As Long
Dim arr() As Variant, dict As Object

' Initialize dictionary object
Set dict = CreateObject("Scripting.Dictionary")

' Get total number of rows that meet the given conditions
n = Application.WorksheetFunction.CountIfs(Range("B27:B142"), "Strength", Range("K27:K142"), "U-PL-1", Range("L27:L142"), 1, Range("M27:M142"), "H")

' Resize array to hold the random numbers
On Error Resume Next
ReDim arr(1 To n, 1 To 1)
On Error GoTo 0

' Generate unique random numbers
For i = 1 To n
Do
j = Int(Rnd() * n) + 1
Loop While dict.Exists(j)
dict(j) = True
arr(i, 1) = j
Next i

' Write the random numbers to the range P27:P142
j = 1
For i = 27 To 142
If Range("B" & i) = "Strength" And Range("K" & i) = "U-Pu-2" And Range("L" & i) = 2 And Range("M" & i) = "H" Then
Range("P" & i).Value = arr(j, 1)
j = j + 1
End If
Next i

' Cleanup
Set dict = Nothing

End Sub

 

[DanteAmor]

Thanks for posting on the forum. Please accept my warmest greetings and sincere hope that all is well.

Reviewing your code, I understand that you want to put a random number to the rows that match the criteria.

But in the first line of matches you have a "U-PL-1" and "1":

n = Application.WorksheetFunction.CountIfs(Range("B27:B142"), "Strength", Range("K27:K142"), "U-PL-1", Range("L27:L142"), 1, Range("M27:M142"), "H")

And in the second line you have "U-Pu-2" and 2:

If Range("B" & i) = "Strength" And Range("K" & i) = "U-Pu-2" And Range("L" & i) = 2 And Range("M" & i) = "H" Then

And that can have consequences, since the count can be different, that's why the out of range error.

While I was reviewing the code, I made some adjustments to make the way of obtaining the random numbers more versatile.
If I am correct with the criteria, you can use the following way to only write them once.

Please try the following code:

Sub STR_UPu2_2_H()
  ' Declare variables
  Dim i As Long, j As Long, n As Long, x As Long, y As Long
  Dim arr() As Variant
  Const crit1 = "Strength", crit2 = "U-PL-1", crit3 = 1, crit4 = "H"
  
  ' Get total number of rows that meet the given conditions
  n = Application.WorksheetFunction.CountIfs(Range("B27:B142"), crit1, _
    Range("K27:K142"), crit2, Range("L27:L142"), crit3, Range("M27:M142"), crit4)
  If n = 0 Then Exit Sub
  
  ' Generate unique random numbers
  arr = Evaluate("ROW(1:" & n & ")")
  Randomize
  For i = 1 To UBound(arr)
    x = Int(UBound(arr) * Rnd + 1)
    y = arr(i, 1)
    arr(i, 1) = arr(x, 1)
    arr(x, 1) = y
  Next i
  
  ' Write the random numbers to the range P27:P142
  For i = 27 To 142
    If Range("B" & i) = crit1 And Range("K" & i) = crit2 And _
       Range("L" & i) = crit3 And Range("M" & i) = crit4 Then
      j = j + 1
      Range("P" & i).Value = arr(j, 1)
    End If
  Next i
End Sub

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[ddub25]

Thanks Dante - of course, schoolboy error. And thanks for the improvement to the code - much appreciated.

Dan

 

[ddub25]

I have just been implementing your revised code for each Sub and it has worked for most, although I get a Run-time error '9' on the Sub below.

It fails on:

y = arr(i, 1)

Is it because that in this instance it only finds 1 row meeting the criteria:

Const crit1 = "Strength", crit2 = "U-Pu-2", crit3 = 4, crit4 = "H"

And therefore only one random number needs to be generated which upsets the code?

Sub STR_UPu2_4_H()

  ' Declare variables
  Dim i As Long, j As Long, n As Long, x As Long, y As Long
  Dim arr() As Variant
  Const crit1 = "Strength", crit2 = "U-Pu-2", crit3 = 4, crit4 = "H"
 
  ' Get total number of rows that meet the given conditions
  n = Application.WorksheetFunction.CountIfs(Range("Category"), crit1, _
    Range("Type"), crit2, Range("Level"), crit3, Range("Home"), crit4)
  If n = 0 Then Exit Sub
 
  ' Generate unique random numbers
  arr = Evaluate("ROW(1:" & n & ")")
  Randomize
  For i = 1 To UBound(arr)
    x = Int(UBound(arr) * Rnd + 1)
    [B][COLOR=rgb(235, 107, 86)]y = arr(i, 1)[/COLOR][/B]
    arr(i, 1) = arr(x, 1)
    arr(x, 1) = y
  Next i
 
  ' Write the random numbers to the range P27:P142
  For i = 27 To 142
    If Range("B" & i) = crit1 And Range("K" & i) = crit2 And _
       Range("L" & i) = crit3 And Range("M" & i) = crit4 Then
      j = j + 1
      Range("P" & i).Value = arr(j, 1)
    End If
  Next i
   
End Sub