Keeping track of tests components VBA

Lenna

Active Member
Joined
Jun 25, 2014
Messages
269
I need help with keeping track of how many components are reported with specific tests.
Here is the logic that I would like to implement with VBA code and insert into my macro. Any help with this would be greatly appreciated.

Thanks,

Lenna

Starting in row 1:
If value in O is either “PRAMO” or “HLAS” and L is not blank
Then
Compare the current row with the row beneath at A, H, N, L and O
If all match,
Return in R (combine value in O & “both”)
Move two rows down and repeat.
If A,H,N,L and O do not match
Return in R (combine value in O & “one”)
Move to the next row

A
B
C
D
E
F
G
H
I
J
K
L
M
N
O
P
Q
R
Patient Id
MR Number
Last Name
First Name
Category
Included In Mailing
Log Time
Sample Date
Assigned Date
Test Type
Test Id
ReportDate
Days2SignOff
Order Number
SoftTestCodes
Repeats
Reportable Comments
CombinedCodes
11
1212212
Smith
Bob
KIDNEY
FALSE
9/10/2014
9/10/2014
9/10/2014
SABI
604562
9/12/2014
2
211003156
HLAS
None

HLASBoth
11
3.3E+07
Smith
Bob
KIDNEY
FALSE
9/10/2014
9/10/2014
9/10/2014
SABII
604563
9/12/2014
2
211003156
HLAS
None

HLASBoth
22
1.3E+07
Jones
Jenn
KIDNEY
FALSE
9/11/2014
9/10/2014
9/12/2014
SABI
604623
9/12/2014
0
211007028
PRAMO
None

PRAMOone
22
1.3E+07
Jones
Jenn
KIDNEY
FALSE
9/11/2014
9/10/2014
9/12/2014
SABII
604624
9/13/2014
0
211007028
PRAMO
None

PRAMOone
33
3.6E+07
Brian
JASON
KIDNEY
TRUE
9/10/2014
9/8/2014
9/12/2014
SABI
604495
9/12/2014
0
211004776
PRAMO
None

PRAMOboth
33
3.6E+07
Brian
JASON
KIDNEY
TRUE
9/10/2014
9/8/2014
9/12/2014
SABII
604496
9/12/2014
0
211004776
PRAMO
None

PRAMOboth
44
1E+08
Ceder
PATRICK
KIDNEY
TRUE
9/11/2014
9/10/2014
9/12/2014
SABI
604621
9/12/2014
0
211004686
PRAMO
None

PRAMOboth
44
1E+08
Ceder
PATRICK
KIDNEY
TRUE
9/11/2014
9/10/2014
9/12/2014
SABII_RPT
604622
9/12/2014
0
211004686
PRAMO
None

PRAMOboth
44
1E+08
Ceder
PATRICK
KIDNEY
TRUE
9/11/2014
9/10/2014
9/12/2014
SABI_RPT
604621

0
211004686
PRAMO
None


44
1E+08
Ceder
PATRICK
KIDNEY
TRUE
9/11/2014
9/10/2014
9/12/2014
SABII
604622

0
211004686
PRAMO
None


55
1E+08
Spear
ANTHONY
KIDNEY
FALSE
9/11/2014
9/10/2014
9/12/2014
LSM__MICA
604649
9/12/2014
0
211007470
HLASM
None


55
1E+08
Spear
ANTHONY
KIDNEY
FALSE
9/11/2014
9/10/2014
9/12/2014
LSMI
604650
9/12/2014
0
211007470
HLASM
None



<tbody>
</tbody>
 

Some videos you may like

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Lenna

Active Member
Joined
Jun 25, 2014
Messages
269
Please help me make this code work. I'm not a programmer and I'm sure it is obvious. :)

Code:
Sub TestComponent ()
Dim cel As Range, rng As Range, lr As Long, r As Long
lr = Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row ’last row of data
    Set rng = Worksheets(1).Range("O2:O" & lr) 'assumes a header row ‘looks in column O 
    For Each cel In rng
        If InStr(cel.Value, "HLAS") > 0 Or InStr(cel.Value, "PRAMO") 0 ‘Looks to see if a cell in column O is either “HLAS” or “PRAMO”
 
‘I don’t know how to look in L to see if it’s not blank?
 
The
        Range("A" & r).Value = Range("A" & r + 1).Value And _ ‘Compare current row with a row beneath at A, H, N, L and O
        Range("H" & r).Value = Range("H" & r + 1).Value And _
        Range("L" & r).Value = Range("L" & r + 1).Value And _
        Range("N" & r).Value = Range("N" & r + 1).Value And _
        Range("O" & r).Value = Range("O" & r + 1).Value Then
 
        ActiveCell.FormulaR1C1 = "=RC[-3]&""both""" ‘in R (combine value in O & “both”)
         r + 2 ‘need to skip one row
        End If
       ActiveCell.FormulaR1C1 = "=RC[-3]&""one"""   ‘in R (combine value in O & “one”)
       Next r
       End Sub

Thanks,

Lenna
 
Last edited:

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,448
Office Version
  1. 2013
Platform
  1. Windows
This worked in test mode. Give it a try.
Code:
Sub evalColOandL()
Dim sh As Worksheet, lr As Long, c As Range, colAry As Variant
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, "O").End(xlUp).Row
colAry = Array("A", "H", "N", "L", "O")
    With sh
        For i = 2 To lr Step 2
            If (.Cells(i, "O") = "HLAS" Or .Cells(i, "O") = "PRAMO") And .Cells(i, "L") <> "" Then
                For j = LBound(colAry) To UBound(colAry)
                    If .Cells(i, colAry(j)) <> .Cells(i + 1, colAry(j)) Then
                        .Cells(i, "R").Resize(2, 1) = .Cells(i, "O").Value & "one"
                        Exit For
                    End If
                    If j = UBound(colAry) Then
                        .Cells(i, "R").Resize(2, 1) = .Cells(i, "O").Value & "both"
                    End If
                Next
            End If
        Next
    End With
End Sub
 

Lenna

Active Member
Joined
Jun 25, 2014
Messages
269
Thank you very much for your help. I've tried to run it with a different data set and there seems to be some problems in rows 7, 8 and 9. The same problem is reoccurring in 12, 13 and 14. Rows 7 and 8 should be HLAboth in R but it showing HLASone in 8 and 9. I'm not sure why this is happening?

Thanks,

Lenna

A
B
C
D
E
F
G
H
I
J
K
L
M
N
O
P
Q
R
Patient Id
MR Number
Last Name
First Name
Category
Included In Mailing
Log Time
Sample Date
Assigned Date
Test Type
Test Id
ReportDate
Days2SignOff
Order Number
SoftTestCodes
Repeats
Comments

25776
1E+08
Smith
JUDITH
KIDNEY REC
#####
######
9/11/2014
9/12/2014
SABI
604891
9/12/2014
0
211103057
HLAS
None

HLASboth
25776
1E+08
Smith
JUDITH
KIDNEY REC
#####
######
9/11/2014
9/12/2014
SABII
604892
9/12/2014
0
211103057
HLAS
None

HLASboth
33896
1E+08
Smith
FLORENCE
KIDNEY REC
#####
######
9/12/2014
9/12/2014
SABI
604942
9/15/2014
3
211201793
PRAMO
None

PRAMOboth
33896
1E+08
Smith
FLORENCE
KIDNEY REC
#####
######
9/12/2014
9/12/2014
SABII
604943
9/15/2014
3
211201793
PRAMO
None

PRAMOboth
34278
1E+08
Smith
DONALD
KIDNEY REC
#####
######
9/12/2014
9/12/2014
SABI
605008
9/15/2014
3
211203313
HLAS
None


34278
1E+08
Smith
DONALD
KIDNEY REC
#####
######
9/12/2014
9/12/2014
SABII
605009
9/15/2014
3
211203313
HLAS
None

HLASone
36741
1E+08
Smith
JACQUELINE
KIDNEY REC
TRUE
######
9/10/2014
9/12/2014
Serum_Stored
604796

####
211104992
PRAMO
None

HLASone
45420
1E+08
Smith
DESTENEE
KIDNEY/LIVER RE
#####
######
9/11/2014
9/12/2014
SABI
604767
9/17/2014
5
211103229
HLAS
None

HLASboth
45420
1E+08
Smith
DESTENEE
KIDNEY/LIVER RE
#####
######
9/11/2014
9/12/2014
SABII
604768
9/17/2014
5
211103229
HLAS
None

HLASboth
48658
1E+08
Smith
JACOB
KIDNEY REC
#####
######
9/10/2014
9/10/2014
SABI
604560
9/16/2014
6
211003698
HLAS
None


48658
1E+08
Smith
JACOB
KIDNEY REC
#####
######
9/10/2014
9/10/2014
SABII
604561
9/16/2014
6
211003698
HLAS
None

HLASone
48840
1E+08
Smith
SARAH
KIDNEY REC
TRUE
######
9/11/2014
9/16/2014
SABI
605070

####
211205238
PRAMO
None

HLASone

<tbody>
</tbody>
This worked in test mode. Give it a try.
Code:
Sub evalColOandL()
Dim sh As Worksheet, lr As Long, c As Range, colAry As Variant
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, "O").End(xlUp).Row
colAry = Array("A", "H", "N", "L", "O")
    With sh
        For i = 2 To lr Step 2
            If (.Cells(i, "O") = "HLAS" Or .Cells(i, "O") = "PRAMO") And .Cells(i, "L") <> "" Then
                For j = LBound(colAry) To UBound(colAry)
                    If .Cells(i, colAry(j)) <> .Cells(i + 1, colAry(j)) Then
                        .Cells(i, "R").Resize(2, 1) = .Cells(i, "O").Value & "one"
                        Exit For
                    End If
                    If j = UBound(colAry) Then
                        .Cells(i, "R").Resize(2, 1) = .Cells(i, "O").Value & "both"
                    End If
                Next
            End If
        Next
    End With
End Sub
 

Lenna

Active Member
Joined
Jun 25, 2014
Messages
269

ADVERTISEMENT

I'm not sure what's exactly wrong with the code but it seems to work when there is an even number of rows in between matching rows (A,H,N,L,O). When the number of rows in between is odd, it skips a row as you can see in the first example.
Patient IdMR NumberLast NameFirst NameCategoryIncluded In MailingLog TimeSample DateAssigned DateTest TypeTest IdReportDateDays2SignOffOrder NumberSoftTestCodesRepeatsComments Codes
257761E+08SmithJUDITHKIDNEY REC###########9/11/20149/12/2014SABI6048919/12/20140211103057HLASNoneHLASboth
257761E+08SmithJUDITHKIDNEY REC###########9/11/20149/12/2014SABII6048929/12/20140211103057HLASNoneHLASboth
500633E+07SmithCONNIEKIDNEY REC###########9/17/20149/17/2014SABII605561####211702372HLASMNone
338961E+08SmithFLORENCEKIDNEY REC###########9/12/20149/12/2014SABI6049429/15/20143211201793PRAMONone
338961E+08SmithFLORENCEKIDNEY REC###########9/12/20149/12/2014SABII6049439/15/20143211201793PRAMONonePRAMOone
557743E+07SmithWILLIEKIDNEY RECTRUE######9/4/20149/15/2014FL__PRAII604825####211105144PRAMONonePRAMOone
567963E+07SmithANGELAKIDNEY RECTRUE######9/10/20149/15/2014FL__PRAI604790####211104964PRAMONone

<tbody>
</tbody>




Patient IdMR NumberLast NameFirst NameCategoryIncluded In MailingLog TimeSample DateAssigned DateTest TypeTest IdReportDateDays2SignOffOrder NumberSoftTestCodesRepeatsComments Codes
257761E+08SmithJUDITHKIDNEY REC###########9/11/20149/12/2014SABI6048919/12/20140211103057HLASNoneHLASboth
257761E+08SmithJUDITHKIDNEY REC###########9/11/20149/12/2014SABII6048929/12/20140211103057HLASNoneHLASboth
500633E+07SmithCONNIEKIDNEY REC###########9/17/20149/17/2014SABII605561####211702372HLASMNone
500633E+07SmithCONNIEKIDNEY REC###########9/17/20149/17/2014SABII605561####211702372HLASMNone
338961E+08SmithFLORENCEKIDNEY REC###########9/12/20149/12/2014SABI6049429/15/20143211201793PRAMONonePRAMOboth
338961E+08SmithFLORENCEKIDNEY REC###########9/12/20149/12/2014SABII6049439/15/20143211201793PRAMONonePRAMOboth
557743E+07SmithWILLIEKIDNEY RECTRUE######9/4/20149/15/2014FL__PRAII604825####211105144PRAMONone




<tbody>
</tbody>
 
Last edited:

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,448
Office Version
  1. 2013
Platform
  1. Windows
The code assumes that there will be two rows of data for each patient ID. No explanation was given in the OP so, the code does not allow for odd numbers of rows per ID. I will look it over and see if I can come up with a solution. If so, I will post it to this thread.
 

Lenna

Active Member
Joined
Jun 25, 2014
Messages
269

ADVERTISEMENT

Sorry I failed to mention it. I'm very grateful for your help.

Lenna

The code assumes that there will be two rows of data for each patient ID. No explanation was given in the OP so, the code does not allow for odd numbers of rows per ID. I will look it over and see if I can come up with a solution. If so, I will post it to this thread.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,448
Office Version
  1. 2013
Platform
  1. Windows
This version will test for the patient ID to make sure there are two rows with the same ID. If so, it will do the comparisons and then move to the next row after the two compared rows. If it finds a row with no match in the second row, it skips that row and goes to the next immediately following row. So all row sets with matching patient ID will be evaluated and status displayed in Column R. Rows with no matching patient ID in the row immediately following will display a blank cell in Column R. Will that work?
Code:
Sub evalColOandL2()
Dim sh As Worksheet, lr As Long, i As Long, colAry As Variant
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, "O").End(xlUp).Row
colAry = Array("A", "H", "N", "L", "O")
    With sh
        For i = 2 To lr
            If .Cells(i, 1).Value = .Cells(i + 1, 1).Value Then
                        If (.Cells(i, "O").Value = "HLAS" Or .Cells(i, "O").Value = "PRAMO") _
                        And .Cells(i, "L").Value <> "" Then
                            For j = LBound(colAry) To UBound(colAry)
                                    If .Cells(i, colAry(j)) <> .Cells(i + 1, colAry(j)) Then
                                        .Cells(i, "R").Resize(2, 1) = .Cells(i, "O").Value & "one"
                                        Exit For
                                    End If
                                    If j = UBound(colAry) Then
                                        .Cells(i, "R").Resize(2, 1) = .Cells(i, "O").Value & "both"
                                    End If
                            Next
                            i = i + 1
                        End If
            End If
        Next
    End With
End Sub
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,448
Office Version
  1. 2013
Platform
  1. Windows
Or If you want those rows with no matching Patient ID to list as Column("O").Value & "one", then this:
Code:
Sub evalColOandL3()
Dim sh As Worksheet, lr As Long, i As Long, colAry As Variant
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, "O").End(xlUp).Row
colAry = Array("A", "H", "N", "L", "O")
    With sh
        For i = 2 To lr
            If .Cells(i, 1).Value = .Cells(i + 1, 1).Value Then
                If (.Cells(i, "O").Value = "HLAS" Or .Cells(i, "O").Value = "PRAMO") _
                    And .Cells(i, "L").Value <> "" Then
                        For j = LBound(colAry) To UBound(colAry)
                            If .Cells(i, colAry(j)) <> .Cells(i + 1, colAry(j)) Then
                                .Cells(i, "R").Resize(2, 1) = .Cells(i, "O").Value & "one"
                                Exit For
                            End If
                            If j = UBound(colAry) Then
                                .Cells(i, "R").Resize(2, 1) = .Cells(i, "O").Value & "both"
                            End If
                        Next
                        i = i + 1
                End If
            Else
                .Cells(i, "R") = .Cells(i, "O").Value & "one"
            End If
            
        Next
    End With
End Sub
 

Lenna

Active Member
Joined
Jun 25, 2014
Messages
269
Normally, there should be always two rows for each HLAS/PRAMO. Sometimes there is only one row for each patient Id with PRAMO/HLAS in O and L is not blank. These are mistakes made by people who ordered and reported the test. We are trying to track and correct these mistakes. So, if there is only one row with PRAMO/HLAS in O and L is not blank it should return the corresponding value from O & "one" not a blank. I hope this makes sense and sorry for the confusion.

I can provide more examples/ further explanations if needed.

Thank you again,

Lenna
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,109,446
Messages
5,528,802
Members
409,836
Latest member
karnasrinivas
Top