Plausibility check via VBA

[Jean-pierre]

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!

[Jean-pierre]

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...

[Paul_Hossler]

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




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