Check data in the particular columns in worksheet and print error message in another worksheet

[roypogo]

Hi

In my worksheet I have some columns with headers as NM1*IL*1 - Member Name, NM1*IL*1 - Dependent Name1, NM1*IL*1 - Dependent Name2, NM1*IL*1 - Dependent Name3 etc. along with other columns which has different headers.

I need to check the data in the columns only which has header beginning with NM1*IL*1 and print the error message in another sheet.

The data check that I need to do is to check the number of * in the cells. If the number of * characters is not eqaual to 9 or 4 or 5 it will print error message.

Below is the original worksheet:

DTP*356* - Member Dates	NM1*IL*1 - Member Name	PER* - Member Communications	NM1*IL*1 - Dependent Name1	NM1*IL*1 - Dependent Name2	DTP*356* - Dependent Dates3	NM1*IL*1 - Dependent Name3
DTP*356*D8*20030101~	NM1*IL*1*Test*ADAM*C***34*111222333~	PER*IP**TE*3174142326~	NM1*IL*1TestALICE*W~	NM1*IL*1*Test*ALICE*W~
DTP*356*D8*20040301~	NM1*IL*1*Test*CHARLES*A****34*111222333~	PER*IP**TE*7087498828~	NM1*IL*1*Test*ALICE*W~		DTP*356*D8*20040301~	NM1*IL*1*Test*ALICE*W~
DTP*356*D8*20040101~	NM1*IL*1*Test*CARRIE*M***34*111222333~	PER*IP**TE*2135551420~	NM1*IL*1*Test*ALICE~		DTP*356*D8*20040101~	NM1*IL*1TestALICE*W~
DTP*356*D8*20020101~	NM1*IL*1*Test*HERSCHEL*D***34**33331122~	PER*IP**TE*6158346201~	NM1*IL*1*Test*ALICE*W~	NM1*IL*1TestALICE*W~

<tbody>
</tbody>

The error sheet should show as:

Error in Row2,ColumnD

Error in Row3,ColumnB

Error in Row4,ColumnG

Error in Row5,ColumnB

Error in Row5,ColumnE

<tbody>
</tbody>

 

[MrKowz]

This is untested, but try:

Public Sub CompileErrors()
Dim LR      As Long, _
    LC      As Long
    
Dim i       As Long, _
    j       As Long, _
    tmp     As String, _
    numAst  As Long, _
    rowx    As Long
    
Dim sWS     As Worksheet, _
    dWS     As Worksheet
    
    
Application.ScreenUpdating = False

Set sWS = ActiveSheet
Set dWS = Sheets.Add
dWS.Name = "Errors"

With sWS
    LR = .Range("B" & Rows.Count).End(xlUp).Row
    LC = .Cells(1, Columns.Count).End(xlToLeft).Column
End With

rowx = 2

For i = 1 To LC
    If Left(sWS.Cells(1, i).Value, 8) = "NM1*IL*1" Then
        For j = 2 To LR
            tmp = sWS.Cells(j, i).Value
            numAst = Len(tmp) - Len(Replace(tmp, "*", ""))
            Select Case numAst
                Case 4, 5, 9
                    'Do Nothing
                Case Else
                    dWS.Range("A" & rowx).Value = "Error in cell " & sWS.Cells(j, i).Address
                    rowx = rowx + 1
            End Select
        Next j
    End If
Next i

Application.ScreenUpdating = True

End Sub