Selected Answer
Sebas
Here's a different approach which delivers an "exception report" i.e. only what's wrong with your data. Not sure if I have understood your rules correctly but...
In the attached revised file, under your table there is a button called "List errors". Clich that and the following macro (with a few guiding comments) will run:
Sub DefineClassColumns()
Dim j As Double, n As Double, Start As Double 'variable for counters and start of class code
Dim XCol As Double, SCol As Double, XRowl As Double, SRow As Double 'variables for class rows and columns
Dim Errors As String
Start = 3
' run through columns
For j = 3 To 23
' do things per code value
XCol = WorksheetFunction.CountIf(Range(Cells(2, j), Cells(6, j)), "=X")
SCol = WorksheetFunction.CountIf(Range(Cells(2, j), Cells(6, j)), "=S")
Select Case XCol
Case Is > 1
Errors = Errors & vbCr & "Value error: >1 X for class " & Cells(1, j).Value
Case Is = 1
If SCol >= 1 Then
Errors = Errors & vbCr & "Value error: S and X for class " & Cells(1, j).Value
Else
End If
Case Is = 0
If SCol > 1 Then Errors = Errors & vbCr & "Value error: >1 S for class " & Cells(1, j).Value
End Select
'find extent of each code class
If Left(Cells(1, j).Value, 2) <> Left(Cells(1, j + 1).Value, 2) Then
'do things per code class
Errors = Errors & vbCr & "Class " & Left(Cells(1, j).Value, 2) & "- columns " & Start & ":" & j
For n = 2 To 6
XRow = WorksheetFunction.CountIf(Range(Cells(n, Start), Cells(n, j)), "=X")
SRow = WorksheetFunction.CountIf(Range(Cells(n, Start), Cells(n, j)), "=S")
Select Case XRow
Case Is > 1
Errors = Errors & vbCr & " Class error: >1 X for ID/Code " & Cells(n, 2).Value
Case Is = 1
If SRow >= 1 Then Errors = Errors & vbTab & vbCr & " Class error: S and X for ID/Code " & Cells(n, 2).Value
Case Is = 0
If SRow > 1 Then Errors = Errors & vbTab & vbCr & " Class error: >1 S for ID/Code " & Cells(n, 2).Value
End Select
Next n
'create start for next code class
Start = j + 1
End If
Next j
n = MsgBox(Errors, vbOKOnly, "Found...")
End Sub
It checks per column for errors then (when it sees a change in class of code) checks per class row for errors.
All errors are collected in a string called "errors" which is displayed in a Message Box at the end of the macro. You could copy that string to a cell or the clipboard.
REVISION:
Further to comments below, the ...v0_b.xlsm revised file below reports only row errors and in the cells to the right of the data cells.
I've added variables for Top, Bottom (rows) and Start, Last (columns) of the data cells. That means you can expand it easily. Results are now recorded in the three columns to the right of column 23. I've also rationalised the Conditional Formatting for the data cells (and added a new rule to highlight any errors in the error column).
Here's the revised code (with comments)
Sub DefineClassColumns()
Dim j As Integer, n As Integer 'variables for counters
Dim Start As Integer, Last As Integer, Top As Integer, Bottom As Integer ' variables for data and start/end of class code
Dim XRow As Integer, SRow As Integer 'variables for class rows
Dim Errors As String
Start = 3 'set first column of data cells
Last = 23 'set last column of data cells
Top = 2 'set first row of data cells
Bottom = 6 'set last row of data cells
Range(Cells(Top, Last + 1), Cells(Bottom, Last + 3)).ClearContents 'clear results cell values only
' run through columns
For j = Start To Last ' do things per code value
For n = Top To Bottom
Cells(n, j).Value = UCase(Cells(n, j).Value) ' make cell CAPS
'record S and X entries (regardless of errors)
If Cells(n, j).Value = "S" Then Cells(n, Last + 1).Value = Cells(n, Last + 1).Value & " " & Cells(Top - 1, j).Value
If Cells(n, j).Value = "X" Then Cells(n, Last + 2).Value = Cells(n, Last + 2).Value & " " & Cells(Top - 1, j).Value
Next n
'find extent of each code class
If Left(Cells(1, j).Value, 2) <> Left(Cells(1, j + 1).Value, 2) Then
'do things per code class
For n = Top To Bottom
XRow = WorksheetFunction.CountIf(Range(Cells(n, Start), Cells(n, j)), "=X")
SRow = WorksheetFunction.CountIf(Range(Cells(n, Start), Cells(n, j)), "=S")
Select Case XRow
Case Is > 1
Cells(n, Last + 3).Value = Cells(n, Last + 3).Value & "Class error: >1 X for " & Left(Cells(Top - 1, j).Value, 2) & "**; "
Case Is = 1
If SRow >= 1 Then Cells(n, Last + 3).Value = Cells(n, Last + 3).Value & "Class error: S and X for " & Left(Cells(Top - 1, j).Value, 2) & "**; "
Case Is = 0
If SRow > 1 Then Cells(n, Last + 3).Value = Cells(n, Last + 3).Value & "Class error: >1 S for " & Left(Cells(Top - 1, j).Value, 2) & "**; "
End Select
Next n
'create start for next code class
Start = j + 1
End If
Next j
MsgBox "Done!"
End Sub
Hope this helps.
