Plausibility check via VBA

Hello everyone,
thank you in advance for your support!


What should the vba code look like if I want to do an automatic data check for the file (see attachment) and output the result as a message box?


Basically, all three sheets should be checked and if errors are found, the names of the sheets + coordinates of the respective cells should be output in the message box.


The following rule applies to all sheets: if a value is missing in columns A,B,C (as in the Volume sheet), then this is an error
The following rule applies to the Sales/Volume sheet: All values ​​in columns D-O must be positive numbers and must not be >100.
The following applies to the Costs sheet: All values ​​in columns D-O must be negative numbers and must not be >-100.


In the case of the attached file, the error message would look like this:


Following errors found:
Sales - cell L5
Cost - cell L5
Cost - Cell I8
Volume - cell C3


who can help me here?
Thank you.


Best regards!

Additional Info: the Excel-file comes from a different system, therefore its not possibile to limit the input-values from the beginning. I have to check it afterwards. And secondly: I am aware that its possibile to check the empty cells using a formula. But since the original file has several thousand lines, I wouldn't want to look through all the lines...

try this

You didn't say what to do with HALLO so I didn't

BTW, you mispelt the Voume worksheet tab, so I changed it to Volume

Suggestion: Instead of a MsgBox, you might want to list errors on a seperate sheet and/or color code them

Code:

---

Option Explicit


'The following rule applies to all sheets: if a value is missing in columns A,B,C (as in the Volume sheet), then this is an error
'The following rule applies to the Sales/Volume sheet: All values ??in columns D-O must be positive numbers and must not be >100.
'The following applies to the Costs sheet: All values ??in columns D-O must be negative numbers and must not be >-100.


Dim sMsg As String


Sub Plaus()
    Dim wsSales As Worksheet, wsVolume As Worksheet, wsCosts As Worksheet
    Dim rSales As Range, rVolume As Range, rCosts As Range, rCell As Range
   
    Set wsSales = Worksheets("Sales")
    Set wsVolume = Worksheets("Volume")
    Set wsCosts = Worksheets("Cost")
   
    Set rSales = wsSales.Cells(1, 1).CurrentRegion
    Set rVolume = wsVolume.Cells(1, 1).CurrentRegion
    Set rCosts = wsCosts.Cells(1, 1).CurrentRegion


    sMsg = vbNullString


    Call Col123(rSales)
    Call Col123(rVolume)
    Call Col123(rCosts)
   
    Call Num(rSales, 0#, 99.999999)
    Call Num(rVolume, 0#, 99.999999)
    Call Num(rCosts, -99.999999, 0#)
   


    MsgBox sMsg


End Sub


Private Sub Col123(r As Range)
    Dim rCell As Range, r1 As Range
   
    With r
   
        Set r1 = .Cells(1, 1).Resize(.Rows.Count, 3)
   
        On Error Resume Next
        For Each rCell In r1.SpecialCells(xlCellTypeBlanks)
            sMsg = sMsg & vbCrLf & rCell.Parent.Name & "- Cell " & rCell.Address
        Next
        On Error GoTo 0
    End With


End Sub




Private Sub Num(r As Range, L As Double, H As Double)
    Dim rCell As Range, r1 As Range
   
    With r
   
        Set r1 = .Cells(2, 4).Resize(.Rows.Count - 1, .Columns.Count - 3)
   
        On Error Resume Next
        For Each rCell In r1.SpecialCells(xlCellTypeConstants, xlNumbers)
            If Not (L <= rCell.Value And rCell.Value <= H) Then
                sMsg = sMsg & vbCrLf & rCell.Parent.Name & "- Cell " & rCell.Address
            End If
        Next
        On Error GoTo 0
    End With


End Sub

---