Runtime Error 5 on very complicated sheet (to me anyway :) )

W

Woodpusher147

Board Regular
Joined
Oct 6, 2021
Messages
69
Office Version
  1. 365
Platform
  1. Windows
Hello
Really hope someone can help with a runtime error I am receiving on pretty complicated workbook.
Someone on here helped me create this but now I cant contact him so I am pretty stuck.

Debug shows the error on this section of the below code
1638530243602.png


VBA Code: 
Option Explicit

Sub Set_Conditional_Formatting()
Dim firstRow&, lastRow&, columnLetter$, red, amber, green, gold, fontColorForRedCells, settingsSheetName$
ReDim descendingListWithoutDuplicates(0 To 0) As String

'**********************************************************
'Inputs
settingsSheetName = "Settings"

red = RGB(255, 0, 0)  'Red
amber = RGB(255, 230, 153) 'Amber
green = RGB(0, 176, 80) 'Green
gold = RGB(255, 255, 0) 'Gold
fontColorForRedCells = RGB(255, 255, 255) 'White
'**********************************************************

ActiveSheet.Cells.FormatConditions.Delete
firstRow = FirstDataRow_In_Current_Sheet(ActiveSheet.Name, settingsSheetName)
lastRow = LastActualDataRow_In_This_Sheet(ActiveSheet.Name, settingsSheetName)

columnLetter = "F"
Call LessThan(85, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(85, 99, columnLetter, firstRow, lastRow, amber)
Call Between(100, 105, columnLetter, firstRow, lastRow, green)
Call GreaterThan(105, columnLetter, firstRow, lastRow, gold)

    columnLetter = "G"
    descendingListWithoutDuplicates = List_Of_Scores_In_Descending_Order_Without_Duplicates(firstRow, lastRow, columnLetter)
    Call Between_Ranks(">9", descendingListWithoutDuplicates, columnLetter, firstRow, lastRow, red, fontColorForRedCells) 'BElow 9th
    Call Between_Ranks("8-9", descendingListWithoutDuplicates, columnLetter, firstRow, lastRow, amber) 'NEXT 2 so 8th and 9th
    Call Between_Ranks("5-7", descendingListWithoutDuplicates, columnLetter, firstRow, lastRow, green) 'NEXT 3 so 5th to 7th
    Call Between_Ranks("1-4", descendingListWithoutDuplicates, columnLetter, firstRow, lastRow, gold) 'TOP 4 SCORES

'    Call LessThan(70, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
'    Call Between(70, 74, columnLetter, firstRow, lastRow, amber)
'    Call Between(75, 79, columnLetter, firstRow, lastRow, green)
'    Call GreaterThan(79, columnLetter, firstRow, lastRow, gold)

columnLetter = "H"
Call LessThan(5, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(5, 9, columnLetter, firstRow, lastRow, amber)
Call Between(10, 14, columnLetter, firstRow, lastRow, green)
Call GreaterThan(14, columnLetter, firstRow, lastRow, gold)

columnLetter = "I"
Call LessThan(65, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(65, 69, columnLetter, firstRow, lastRow, amber)
Call Between(70, 74, columnLetter, firstRow, lastRow, green)
Call GreaterThan(74, columnLetter, firstRow, lastRow, gold)

columnLetter = "J"
Call LessThan(20, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(20, 23, columnLetter, firstRow, lastRow, amber)
Call Between(24, 29, columnLetter, firstRow, lastRow, green)
Call GreaterThan(29, columnLetter, firstRow, lastRow, gold)

columnLetter = "K"
Call LessThan(75, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(75, 79, columnLetter, firstRow, lastRow, amber)
Call Between(80, 84, columnLetter, firstRow, lastRow, green)
Call GreaterThan(84, columnLetter, firstRow, lastRow, gold)

columnLetter = "L"
Call LessThan(20, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(20, 25, columnLetter, firstRow, lastRow, amber)
Call Between(26, 33, columnLetter, firstRow, lastRow, green)
Call GreaterThan(33, columnLetter, firstRow, lastRow, gold)

columnLetter = "M"
Call LessThan(20, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(20, 25, columnLetter, firstRow, lastRow, amber)
Call Between(26, 33, columnLetter, firstRow, lastRow, green)
Call GreaterThan(33, columnLetter, firstRow, lastRow, gold)

columnLetter = "N"
Call LessThan(35, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(35, 39, columnLetter, firstRow, lastRow, amber)
Call Between(40, 59, columnLetter, firstRow, lastRow, green)
Call GreaterThan(59, columnLetter, firstRow, lastRow, gold)

columnLetter = "O"
Call LessThan(50, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(50, 64, columnLetter, firstRow, lastRow, amber)
Call Between(65, 74, columnLetter, firstRow, lastRow, green)
Call GreaterThan(74, columnLetter, firstRow, lastRow, gold)

columnLetter = "P"
Call LessThan(80, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(80, 84, columnLetter, firstRow, lastRow, amber)
Call Between(85, 89, columnLetter, firstRow, lastRow, green)
Call GreaterThan(89, columnLetter, firstRow, lastRow, gold)

End Sub

Sub DeleteFormatConditions(columnLetter1 As String, columnLetter2 As String, firstRow As Long, lastRow As Long)
Range(columnLetter1 & firstRow & ":" & columnLetter2 & lastRow).FormatConditions.Delete
End Sub

Sub LessThan(num As Variant, columnLetter As String, firstRow As Long, lastRow As Long, colorr As Variant, Optional ByVal fontColor As Long = 0)
With Range(columnLetter & firstRow & ":" & columnLetter & lastRow).FormatConditions.Add(Type:=xlCellValue, Operator:=xlBetween, Formula1:=1, Formula2:=num - 1)
    .Interior.Color = colorr
    .Font.Color = fontColor
    .StopIfTrue = False
End With
End Sub

Sub GreaterThan(num As Variant, columnLetter As String, firstRow As Long, lastRow As Long, colorr As Variant, Optional ByVal fontColor As Long = 0)
With Range(columnLetter & firstRow & ":" & columnLetter & lastRow).FormatConditions.Add(Type:=xlCellValue, Operator:=xlGreater, Formula1:=num)
    .Interior.Color = colorr
    .Font.Color = fontColor
    .StopIfTrue = False
End With
End Sub

Sub Between(num1 As Variant, num2 As Variant, columnLetter As String, firstRow As Long, lastRow As Long, colorr As Variant, Optional ByVal fontColor As Long = 0)
With Range(columnLetter & firstRow & ":" & columnLetter & lastRow).FormatConditions.Add(Type:=xlCellValue, Operator:=xlBetween, Formula1:=num1, Formula2:=num2)
    .Interior.Color = colorr
    .Font.Color = fontColor
    .StopIfTrue = False
End With
End Sub
Sub Test__Between_Ranks()

Dim firstRow&, lastRow&, columnLetter$, red, amber, green, gold, fontColorForRedCells, settingsSheetName$, columnLetterOfPoints$
ReDim descendingListWithoutDuplicates(0 To 0) As String

red = RGB(255, 0, 0)  'Red
amber = RGB(255, 230, 153) 'Amber
green = RGB(0, 176, 80) 'Green
gold = RGB(255, 255, 0) 'Gold
fontColorForRedCells = RGB(255, 255, 255) 'White

settingsSheetName = "Settings"
columnLetter = "G"
firstRow = 7
lastRow = LastActualDataRow_In_This_Sheet(ActiveSheet.Name, settingsSheetName)

descendingListWithoutDuplicates = List_Of_Scores_In_Descending_Order_Without_Duplicates(firstRow, lastRow, columnLetter)
Call Between_Ranks(">7", descendingListWithoutDuplicates, columnLetter, firstRow, lastRow, red, fontColorForRedCells)

End Sub
Sub Between_Ranks(expr As String, descendingListWithoutDuplicates As Variant, columnLetter As String, firstRow As Long, lastRow As Long, colorr As Variant, Optional ByVal fontColor As Long = 0)

Dim num1 As Variant
Dim num2 As Variant
ReDim twoNumbers(0 To 1) As String

If InStr(expr, ">") > 0 Then
    num1 = Trim(SubString(expr, InStr(expr, ">") + 1, Len(expr)))
    num2 = num1
Else
    twoNumbers = Split(expr, "-")
    num1 = twoNumbers(0)
    num2 = twoNumbers(1)
End If

Dim i As Integer

'OR(G7=32,G7=111)

Dim cf_Formula As String
cf_Formula = "=OR("

'Debug.Print expr

If num1 = num2 Then
    i = num1
    Do While i <= UBound(descendingListWithoutDuplicates)
        cf_Formula = cf_Formula & columnLetter & firstRow & "=" & descendingListWithoutDuplicates(i) & ","
        i = i + 1
    Loop
Else
    'Debug.Print "[" & num1 & "," & num2 & "]"
    i = num1 - 1
    Do While i <= num2 - 1
        'Debug.Print descendingListWithoutDuplicates(i), i
        cf_Formula = cf_Formula & columnLetter & firstRow & "=" & descendingListWithoutDuplicates(i) & ","
        i = i + 1
    Loop
End If
cf_Formula = SubString(cf_Formula, 1, Len(cf_Formula) - 1)
cf_Formula = cf_Formula & ")"

'Debug.Print cf_Formula

With Range(columnLetter & firstRow & ":" & columnLetter & lastRow).FormatConditions.Add(Type:=xlExpression, Formula1:=cf_Formula)
    .Interior.Color = colorr
    .Font.Color = fontColor
    .StopIfTrue = False
End With

End Sub






Sub Test__List_Of_Scores_In_Descending_Order_Without_Duplicates()

Dim settingsSheetName As String
settingsSheetName = "Settings"

Dim columnLetter As String
columnLetter = "G"

Dim firstRow As Long
firstRow = FirstDataRow_In_Current_Sheet(ActiveSheet.Name, settingsSheetName)

Dim lastRow As Long
lastRow = LastActualDataRow_In_This_Sheet(ActiveSheet.Name, settingsSheetName)

ReDim descendingListWithoutDuplicates(0 To 0) As String
descendingListWithoutDuplicates = List_Of_Scores_In_Descending_Order_Without_Duplicates(firstRow, lastRow, columnLetter)

Debug.Print "------------------"

Dim i As Integer
i = 0
Do While i <= UBound(descendingListWithoutDuplicates)
    Debug.Print descendingListWithoutDuplicates(i), i + 1
    i = i + 1
Loop

Debug.Print "------------------"

End Sub
Function List_Of_Scores_In_Descending_Order_Without_Duplicates(firstRow As Long, lastRow As Long, columnLetter As String)

Dim i As Integer
Dim stringListOfScores As String

Dim arr() As Variant
arr = Range(columnLetter & firstRow & ":" & columnLetter & lastRow)
arr = Quicksort(arr, 1, UBound(arr))

'DeleteDuplicates
stringListOfScores = ""
i = UBound(arr)
Do While i >= 1
    If Trim(arr(i, 1)) = "" Then arr(i, 1) = 0
    stringListOfScores = stringListOfScores & arr(i, 1) & ","
    'Debug.Print arr(i, 1)
    i = i - 1
Loop
stringListOfScores = SubString(stringListOfScores, 1, Len(stringListOfScores) - 1)
'Debug.Print stringListOfScores

stringListOfScores = NoDupWords(stringListOfScores, ",")
'Debug.Print stringListOfScores

ReDim descendingListWithoutDuplicates(0 To 0) As String
descendingListWithoutDuplicates = Split(stringListOfScores, ",")

List_Of_Scores_In_Descending_Order_Without_Duplicates = descendingListWithoutDuplicates

End Function




Sub Test__LastActualDataRow_In_This_Sheet()
MsgBox LastActualDataRow_In_This_Sheet(ActiveSheet.Name, "Settings")
End Sub
Function LastActualDataRow_In_This_Sheet(sheetName As String, settingsSheetName As String)

Dim departmentColumnLetterInCurrentStoreSheet As String
Dim currentSheetRowInSettingsSheet As Long
currentSheetRowInSettingsSheet = First_Row_With_This_Text_In_This_Column(settingsSheetName, "A", sheetName)

Dim i As Integer
i = 1
Do While i <= Last_Non_Blank_Column_In_This_Row(settingsSheetName, 4)
    If InStr(Sheets(settingsSheetName).Cells(4, i), "*") > 0 Then
        departmentColumnLetterInCurrentStoreSheet = Split(Sheets(settingsSheetName).Range(Sheets(settingsSheetName).Cells(currentSheetRowInSettingsSheet, i).Value).Address, "$")(1)
        GoTo Next_Step
    End If
    i = i + 1
Loop
Next_Step:
LastActualDataRow_In_This_Sheet = Last_Non_Blank_Row_In_This_Column(sheetName, departmentColumnLetterInCurrentStoreSheet)

End Function


Sub Test__Quicksort()

Dim arr() As Variant
arr = Range("Q6:Q18")
arr = Quicksort(arr, 1, UBound(arr))
Dim i As Integer
i = 1
Do While i <= UBound(arr)
    Debug.Print arr(i, 1)
    i = i + 1
Loop

End Sub
Function Quicksort(vArray As Variant, arrLbound As Long, arrUbound As Long)
'Sorts a one-dimensional VBA array from smallest to largest
'using a very fast quicksort algorithm variant.
Dim pivotVal As Variant
Dim vSwap    As Variant
Dim tmpLow   As Long
Dim tmpHi    As Long
 
tmpLow = arrLbound
tmpHi = arrUbound
pivotVal = vArray((arrLbound + arrUbound) \ 2, 1)
 
While (tmpLow <= tmpHi) 'divide
   While (vArray(tmpLow, 1) < pivotVal And tmpLow < arrUbound)
      tmpLow = tmpLow + 1
   Wend
  
   While (pivotVal < vArray(tmpHi, 1) And tmpHi > arrLbound)
      tmpHi = tmpHi - 1
   Wend
 
   If (tmpLow <= tmpHi) Then
      vSwap = vArray(tmpLow, 1)
      vArray(tmpLow, 1) = vArray(tmpHi, 1)
      vArray(tmpHi, 1) = vSwap
      tmpLow = tmpLow + 1
      tmpHi = tmpHi - 1
   End If
Wend
 
  If (arrLbound < tmpHi) Then Quicksort vArray, arrLbound, tmpHi 'conquer
  If (tmpLow < arrUbound) Then Quicksort vArray, tmpLow, arrUbound 'conquer

Quicksort = vArray

End Function



Sub Test__FirstDataRow_In_Current_Sheet()
MsgBox FirstDataRow_In_Current_Sheet(ActiveSheet.Name, "Settings")
End Sub
Function FirstDataRow_In_Current_Sheet(sheetName As String, settingsSheetName As String)

Dim currentSheetRowInSettingsSheet As Long
Dim cellAddress As String
currentSheetRowInSettingsSheet = First_Row_With_This_Text_In_This_Column(settingsSheetName, "A", sheetName)
If currentSheetRowInSettingsSheet = 0 Then
    MsgBox "This store sheet name is not listed (verbatim) in the settings sheet!", vbCritical, "Conditional Formatting Not Set"
    End
End If

Dim i As Integer
i = 1
Do While i <= Last_Non_Blank_Column_In_This_Row(settingsSheetName, 4)
    If InStr(Sheets(settingsSheetName).Cells(4, i), "&") > 0 Then
        cellAddress = Sheets(settingsSheetName).Cells(currentSheetRowInSettingsSheet, i).Value
        FirstDataRow_In_Current_Sheet = Range(cellAddress).Row
        Exit Function
    End If
    i = i + 1
Loop

End Function


'==========================================
'Not used, but may be needed in the future!
'==========================================
Sub Test__ColumnLetter_WithPoints_In_Current_Sheet()
MsgBox ColumnLetter_WithPoints_In_Current_Sheet(ActiveSheet.Name, "Settings")(1)
MsgBox ColumnLetter_WithPoints_In_Current_Sheet(ActiveSheet.Name, "Settings")(2)
End Sub
Function ColumnLetter_WithPoints_In_Current_Sheet(sheetName As String, settingsSheetName As String)

Dim currentSheetRowInSettingsSheet As Long
Dim cellAddress As String
currentSheetRowInSettingsSheet = First_Row_With_This_Text_In_This_Column(settingsSheetName, "A", sheetName)
If currentSheetRowInSettingsSheet = 0 Then
    MsgBox "This store sheet name is not listed (verbatim) in the settings sheet!", vbCritical, "Conditional Formatting Not Set"
    End
End If

ReDim output(1 To 2) As String

Dim i As Integer
i = 1
Do While i <= Last_Non_Blank_Column_In_This_Row(settingsSheetName, 4)
    If InStr(Sheets(settingsSheetName).Cells(4, i), "&") > 0 Then
        cellAddress = Sheets(settingsSheetName).Cells(currentSheetRowInSettingsSheet, i).Value
        output(1) = Split(Sheets(settingsSheetName).Range(cellAddress).Address, "$")(1)
        output(2) = cellAddress
        ColumnLetter_WithPoints_In_Current_Sheet = output
        Exit Function
    End If
    i = i + 1
Loop

End Function


I can provide more details if there is anyone who thinks they could help

Many thanks for looking

Simon
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Sort by date Sort by votes
What's the value of cf_formula when the error occurs?
 
Upvote 0
RoryA said:
What's the value of cf_formula when the error occurs?
Click to expand...
Thank you for the quick reply.
Im afraid I'm not sure how to get that.
Sorry but this is not my skill at all which is why I came here in the first place :/

How can I find that value?


THanks
 
Upvote 0
When the code breaks and you press Debug, in the immediate window (Ctrl+G if it's not already visible) type:

Code: 
?cf_formula

and press enter.
 
Upvote 0
There's the problem then. That is not a valid formula.
 
Upvote 0
OK but what can I do?

ITs part of this
VBA Code: 
Sub Between_Ranks(expr As String, descendingListWithoutDuplicates As Variant, columnLetter As String, firstRow As Long, lastRow As Long, colorr As Variant, Optional ByVal fontColor As Long = 0)

Dim num1 As Variant
Dim num2 As Variant
ReDim twoNumbers(0 To 1) As String

If InStr(expr, ">") > 0 Then
    num1 = Trim(SubString(expr, InStr(expr, ">") + 1, Len(expr)))
    num2 = num1
Else
    twoNumbers = Split(expr, "-")
    num1 = twoNumbers(0)
    num2 = twoNumbers(1)
End If

Dim i As Integer

'OR(G7=32,G7=111)

Dim cf_Formula As String
cf_Formula = "=OR("

'Debug.Print expr

If num1 = num2 Then
    i = num1
    Do While i <= UBound(descendingListWithoutDuplicates)
        cf_Formula = cf_Formula & columnLetter & firstRow & "=" & descendingListWithoutDuplicates(i) & ","
        i = i + 1
    Loop
Else
    'Debug.Print "[" & num1 & "," & num2 & "]"
    i = num1 - 1
    Do While i <= num2 - 1
        'Debug.Print descendingListWithoutDuplicates(i), i
        cf_Formula = cf_Formula & columnLetter & firstRow & "=" & descendingListWithoutDuplicates(i) & ","
        i = i + 1
    Loop
End If
cf_Formula = SubString(cf_Formula, 1, Len(cf_Formula) - 1)
cf_Formula = cf_Formula & ")"

'Debug.Print cf_Formula

With Range(columnLetter & firstRow & ":" & columnLetter & lastRow).FormatConditions.Add(Type:=xlExpression, Formula1:=cf_Formula)
    .Interior.Color = colorr
    .Font.Color = fontColor
    .StopIfTrue = False
End With

End Sub

I really have no idea what I can do but really need to sort :/


THanks again
 
Upvote 0
It would appear that the descendingListWithoutDuplicates array is empty. There's too much code there (and no data) for me to tell you why.
 
Upvote 0
I'd need the workbook. The most likely issue I can suggest from a quick skim is that the code doesn't specify which sheet to get the list from, so it will be working off whatever sheet is active.
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Solved
Quick Sort for 2D Array Multiple Column Sort Ascending Descending and Transposed
2
Replies
14
Views
6K
Fibo
F
C
  • Question Question
Runtime Error only on some sheets - Macro reference "Active Sheet"
Replies
5
Views
555
RoryA
RoryA
Darren Bartrup
  • Solved
UDF to separate date ranges where they overlap.
Replies
5
Views
2K
pgc01
P
V
  • Question Question
Using UDF on multiple sheets causes #NAME? error
Replies
7
Views
976
VfTom
V
M
  • Question Question
Invalid procedure call or argument (Run-time error '5')
Replies
2
Views
3K
Mindy2017
M

Forum statistics

Threads
1,223,882
Messages
6,175,165
Members
452,615
Latest member
bogeys2birdies

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top