Keeping track of tests components VBA

L

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>
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
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:
Upvote 0
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
 
Upvote 0
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>
JLGWhiz said:
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
Click to expand...
 
Upvote 0
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:
Upvote 0
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.
 
Upvote 0
Sorry I failed to mention it. I'm very grateful for your help.

Lenna

JLGWhiz said:
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.
Click to expand...
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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:
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question
Excel Pivot table Time Values is not populating same as Source Sheet
Replies
1
Views
302
awoohaw
awoohaw
F
  • Solved
A simple project update VBA that is not match the projects
Replies
9
Views
218
NoSparks
N
F
  • Question
Graph Help
Replies
2
Views
164
Fegal
F
K
  • Question
Help with difference between 2 dates including am/pm and check multiple entries to see if they occur at the same date and am/pm
Replies
1
Views
149
XLfriend777
XLfriend777
Chris_010101
  • Question
Filter Data?
2
Replies
16
Views
1K
kevin9999
K

Forum statistics

Threads
1,214,631
Messages
6,120,640
Members
448,974
Latest member
DumbFinanceBro

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top