VBA script to extract data based on multiple columns

Hello Again,

Below is my script it is working find on single column but i need to have combination of multiple columns but i failed.

Can someone enhance the below script. Copy of workbook is attached for your reference.

Problem Here

myval = data(i, 15)
        If Not myval Like "J03*" Then
        'If Not myval Like "J03*" Then
    Else
        If errstr = "" Then errstr = "Error 2" Else errstr = errstr & ", " & "Error 2"
        result(j, 15) = temp
    End If

Original code:-

Option Compare Text

Sub ProblemLog()

With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
    End With

Dim data, result, rng2color As Range, rcount As Long, colcount As Long, j As Long, i As Long, myval, errstr As String
Const temp = "#%$#"

If ActiveSheet.Name = "Claims Data" Or ActiveSheet.Name = "Template" Then

data = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Resize(, 46)

rcount = UBound(data)
colcount = UBound(data, 2)

ReDim result(1 To rcount, 1 To colcount + 1)

result(1, 1) = "Provider"
result(1, 2) = "Box Number"
result(1, 3) = "Claim Number"
result(1, 4) = "Treatment Date"
result(1, 5) = "Discharge Date"
result(1, 6) = "Benefit Type"
result(1, 7) = "Member PIN"
result(1, 8) = "Member Name"
result(1, 9) = "Member Class"
result(1, 10) = "Policy  Number"
result(1, 11) = "Policy Holder Name"
result(1, 12) = "Policy Benefit"
result(1, 13) = "Network Type"
result(1, 14) = "Policy Type"
result(1, 15) = "Diagnosis"
result(1, 16) = "Gross"
result(1, 17) = "Discount"
result(1, 18) = "Deductible"
result(1, 19) = "Rejected Amount"
result(1, 20) = "Approved Amount"
result(1, 21) = "Total difference"
result(1, 22) = "Created By "
result(1, 23) = "Created Date"
result(1, 24) = "Created Time"
result(1, 25) = "Pre-Auth Limit"
result(1, 26) = "Approval Number"
result(1, 27) = "Approval Date"
result(1, 28) = "Auditor"
result(1, 29) = "Difference Reason"
result(1, 30) = "Description"
result(1, 31) = "Claim Caution"
result(1, 32) = "Marital Status"
result(1, 33) = "Gender"
result(1, 34) = "Insured Type"
result(1, 35) = "Age"
result(1, 36) = "Chronic"
result(1, 37) = "Pre Existing"
result(1, 38) = "Fraud"
result(1, 39) = "Emergency"
result(1, 40) = "Follow Up"
result(1, 41) = "File Number"
result(1, 42) = "Notes"
result(1, 43) = "Claim Status"
result(1, 44) = "Recovery Amount"
result(1, 45) = "Approved VAT Amount"
result(1, 46) = "Rejected VAT Amount"
result(1, 47) = "Remarks"


j = 1

For i = 2 To rcount
    j = j + 1

    myval = data(i, 15)
    If Not myval Like "Z00*" Then
    Else
        errstr = "Error 1"
        result(j, 15) = temp
    End If
    
    myval = data(i, 15)
        If Not myval Like "J03*" Then
        'If Not myval Like "J03*" Then
    Else
        If errstr = "" Then errstr = "Error 2" Else errstr = errstr & ", " & "Error 2"
        result(j, 15) = temp
    End If

    If errstr <> "" Then
        For n = 1 To colcount
            result(j, n) = result(j, n) & data(i, n)
        Next
        result(j, 47) = errstr
        errstr = ""
    Else: j = j - 1
    End If
Next
Application.ScreenUpdating = 0
Application.ReplaceFormat.Interior.ColorIndex = 6

'*******************************************************************************************************************************************************************

Sheets.Add(Before:=Sheets("Claims Data")).Name = "ErrorLog"
With Worksheets("ErrorLog")
    .Range("a1").Resize(j, colcount + 1) = result
    With .Range("a1").Resize(, colcount + 1)
        .Interior.ColorIndex = 55
        .Font.ColorIndex = 2
        .Font.Bold = 1
        .HorizontalAlignment = xlCenter
    End With
    With .UsedRange
        .Font.Name = "Calibri"
        .Font.Size = 9
        .Borders.LineStyle = xlContinuous
        .Offset(, 1).Resize(, 47).Replace what:=temp, replacement:="", lookat:=xlPart, ReplaceFormat:=True
        .Offset(, 1).Resize(, 47).Replace what:=temp, replacement:="", lookat:=xlPart
    End With
End With

Else
Response = MsgBox("This option will not for sheet: " & UCase(ActiveSheet.Name) & vbCrLf + "Please select/active below worksheets to use this option." _
+ vbCrLf + " " + vbCrLf + "1. DATA Worksheet" + vbCrLf + "2. TEMPLATE Worksheet" + vbCrLf + " " + vbCrLf + "                                      Abdul Aleem - Lets Make Life Easier...", vbOKOnly + vbInformation, "Underwriting Department")

End If

'*******************************************************************************************************************************************************************

With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub

Hi Abdur_rahman,

What your code basically does is copy any Diagnosis (column #15) that starts with J03 to a new sheet. What do you want it to do ? Which other column should the code look against or consider ?

Thank you Nankw for your response.

I need to check if the J03 diagnosis in column O and if the Age in column AI is less then 6 then extract the data.

I just need the idea only how should i combine it.

I have tries like If Not myval Like "J03*" and data(i, 35) < 6 Then but doesn't work.

If you need to extract data that start with J03 & age < 6 get rid of the Not

Try the below

If myval Like "J03*" And Data(i, 35) < 6 Then

No it doesn't work it is extracting other diagnosis also. Ex: J40, J06, etc..

Ok, how about this ?

              If Not myVal Like "J03*" Then 'And Data(i, 35) < 6 Then
              'If Not myval Like "J03*" Then
          Else
            If Data(i, 35) < 6 Then
               If errStr = "" Then errStr = "Error 2" Else errStr = errStr & ", " & "Error 2"
               result(j, 15) = temp
            End If
          End If

Thanks nankwa it works.

If i need to valid 3 columns then again i have add another if condition.

Thanks.

Honestly your code is a bit confusing ... Why do you use Not then nothing Else 'your code' ??

Instead of this

If Not myVal Like "Z00*" Then
'nothing here
Else
    errStr = "Error 1"
    result(j, 15) = temp
End If

myVal = Data(i, 15)
If Not myVal Like "J03*" Then
'nothing here
Else
   If errStr = "" Then errStr = "Error 2" Else errStr = errStr & ", " & "Error 2"
   result(j, 15) = temp
End If

Why not just write this ?

If myVal Like "Z00*" Then
    errStr = "Error 1"
    result(j, 15) = temp
End If

myVal = Data(i, 15)
If myVal Like "J03*" And Data(i, 35) < 6 Then
   If errStr = "" Then errStr = "Error 2" Else errStr = errStr & ", " & "Error 2"
   result(j, 15) = temp
End If

Why so complicated? errStr can only get 1 value per row in this setup. Like "J03 *" is the same as left (value, 3).

Sub VenA()
  With Sheets("Claims Data").Cells(1).CurrentRegion
    ar = .Resize(, .Columns.Count + 1)
    ar(1, 47) = "Remarks"
  End With
  
  For j = 2 To UBound(ar)
    If LCase(Left(ar(j, 15), 3)) = "j03" And ar(j, 35) < 6 Then ar(j, 47) = "Error 2"
    If LCase(Left(ar(j, 15), 3)) = "z00" Then ar(j, 47) = "Error 1"
  Next j
  
  If IsError(Evaluate("'Errorlog'!A1")) Then Sheets.Add(Sheets("Claims Data")).Name = "Errorlog"
    With Sheets("Errorlog")
      .UsedRange.Clear
    .Cells(1).Resize(UBound(ar), 47) = ar
    With .Cells(1).CurrentRegion
      .AutoFilter 47, ""
      .Offset(1).EntireRow.Delete
      .AutoFilter
      With .Rows(1)
        .Interior.ColorIndex = 55
        .Font.ColorIndex = 2
        .Font.Bold = 1
        .HorizontalAlignment = xlCenter
      End With
      .Font.Name = "Calibri"
      .Font.Size = 9
      .Borders.LineStyle = xlContinuous
    End With
  End With
End Sub

Thanks to both of you.

nankw83 i try your idea but it works on some matching and some skip.

Vraag let me try your idea and get back you with feedback.

Thanks once again.

Thanks for your help.

Might be i have to approach in different way. So i will close this topic and open a new topic. I need to have a list on 1 sheet and validate those items and export the data.

Thank once again.

Glad to help & thanks for the reps