Range saving the result of a validity check possible?

user_16432991 0
Viewed 31

I am writing several UDFs which all take a Range as input. As I need to check whether or not the user input is valid I have built another Function to check things like IsNumeric or IsEmpty and so on. Everytime a check has finished it, there is a MsgBox if there have been some issues detected. I want to keep this MsgBox but as there are different UDFs which will be used on the same Range I wanted to ask if I can reduce the amount of Pop-ups? If there is a way to "save" the fact that another Function has already compleated the validity check for this Range? There is no way to know in advance how many times any of the functions are going to be called.

My code is too long and has other issues as well but this is the basic idea:

Public Const maxn As Long = 10

Function Check(myRange As Range, p As Long, n As Long) As Boolean
    Dim i As Long, k As Long, x As Long
    Dim emptyCell As String, noNum As String, emptyRow As String 
    Dim empty(1 To maxn) As Long 

    For i = 1 To p
        For k = 1 To n
            If IsEmpty(myRange.Cells(i, k).Value) Then
                x = x + 1
                empty(k) = 1
                If x = n Then
                    emptyRow = emptyRow & vbLf & CStr(myRange.Row + i - 1)
                End If
            ElseIf Not IsNumeric(myRange.Cells(i, k).Value) Then
                noNum = noNum & vbLf & ColNo2ColLet(myRange.Column + k - 1) & CStr(myRange.Row + i - 1)
            End If
            If k = n And x > 0 And x <> n Then
                For x = 1 To n
                    If empty(x) = 1 Then emptyCell = emptyCell & vbLf & ColNo2ColLet(myRange.Column + x - 1) & CStr(myRange.Row + i - 1)
                Next x
            End If
        Next k
    Next i
    
    If emptyRow <> "" Then
        emptyRow = "Following rows are empty and will not be considered:" & emptyRow
        MsgBox (emptyRow)
    End If
    If emptyCell <> "" Then
        emptyCell = "Following cells are empty and will not be considered:" & emptyCell
        MsgBox (emptyCell)
    End If
    If noNum <> "" Then
        noNum = "Following cells contain nonnumeric values:" & noNum
        MsgBox (noNum)
        Check = CVErr(xlErrValue)
        Exit Function
    End If
    Check = True
End Function

Function ColNo2ColLet(x as Long) as String
'returns the Letters corresponding to the Column number provided by myRange.Column
End Function

Function sr(myRange As Range) as Double
    ' p, n get defined and checked
    Call Check(myRange, p, n)
    ' other calculations
End Function

Function Q(myRange As Range) as Double
    ' p, n get defined and checked
    Call Check(myRange, p, n)
    ' other calculations
End Function
range vba excel
1 Answers

This is what I do. I declare one variable to store messages and then "collect" messages in that. Finally I just show 1 message box in the end with all the messages in one go.

Option Explicit

Dim msg As String

Sub Sample()
    Dim Ret As Variant
    msg = ""

    Ret = SomeFunctionA(1)
    Ret = SomeFunctionB(1)
    
    If msg <> "" Then MsgBox msg
End Sub

Function SomeFunctionA(x As Long) As String
    '
    '~~> Some code
    '
    If msg = "" Then msg = "Error A" Else msg = msg & vbNewLine & "Error A"
End Function

Function SomeFunctionB(x As Long) As String
    '
    '~~> Some code
    ' 
    If msg = "" Then msg = "Error B" Else msg = msg & vbNewLine & "Error B"
End Function

Alternative way if you do not want to type If msg = "" Then msg = ... again and again

Option Explicit

Dim msg As String

Sub Sample()
    Dim Ret As Variant
    msg = ""
    
    Ret = SomeFunctionA(1)
    Ret = SomeFunctionB(1)
    
    If msg <> "" Then MsgBox msg
End Sub

Function SomeFunctionA(x As Long) As String
    '
    '~~> Some code
    '
    StoreMessage "Error A"
End Function

Function SomeFunctionB(x As Long) As String
    '
    '~~> Some code
    '
    StoreMessage "Error B"
End Function

Private Sub StoreMessage(s As String)
    If msg = "" Then msg = s Else msg = msg & vbNewLine & s
End Sub
user_11405790
Related