Comparing one array to another array

[vapelata]

I work in a clinical laboratory and part of my job is to do instrument comparisons. I have two urinalysis instruments which give similar but different results.
Example: Glucose: Iris: reports as 0, 70,100,150,200,250,300,500,1000,>1000.
Glucose: Clinitiek: reports as 0. trace, 250, 500, 1000.

I want to compare results on 10 different random patients between the two instruments. To pass the comparison, they must agree within one grade. So If I got 100 on the Iris, the Clinitek would pass if it result trace or 250, etc. How can I set this up to automatically to the comparisons by entering the data only?

Valetta Pelata
Memorial Hermann Healthcare systems

 

[Worf]

Hello Valetta

I could write a VBA macro to solve this. Then, you would press a button on your sheet and the results would be displayed.

Is this suitable for you?

 

[Worf]

Already started working on this...
Probably I'll be able to post the solution this Tuesday.

 

[vapelata]

Thank you. Will this be able to embed in an excel spreadsheet and run in background?

 

[Worf]

Hi Valetta
It seems to be working... Please note the following:
- You need a data sheet called VP, with the layout shown below. The colors at column D were achieved with conditional formatting.
- The Clinitek array is: 0, trace, 250, 500, 1000
- When in Excel, press Alt-F11 to go to Visual Basic. Click Insert / Module and place the code below there. Press Alt-F11 to return to Excel. Press Alt-F8 to bring up the Macro dialog box and run the Gluc macro. It should analyze 10 random patients from the list previously entered in the VP worksheet.
- If you need more help to implement this, get wrong results or need some modifications, just write back.

Excel Workbook
	A	B	C	D	E	F	G	H
1	Patient	Iris	Clinitek	Compare				Patient Number
2	a	0	trace		1	2	0	8
3	s	70	250	PASS	0	3	0	3
4	d	100	trace		0	4	0	9
5	f	150	500	FAIL	0	5	0	14
6	g	200	0		1	6	0	19
7	h	250	250	PASS	0	7	0	17
8	j	300	1000	FAIL	0	8	0	7
9	k	500	250	PASS	1	9	0	5
10	l	1000	250		1	10	0	20
11	z	>1000	1000		1	11	0	16
12	x	500	500		0	12	1	13
13	cv	>1000	500		0	13	1	10
14	n	200	500	FAIL	0	14	1	12
15	u	0	0		0	15	1	11
16	y	150	250	PASS	1	16	1	6
17	fg	1000	500	PASS	0	17	1	4
18	mmm	70	0		1	18	1	18
19	www	> 1000	0	FAIL	0	19	1	15
20	jas	200	250	PASS	0	20	1	2
VP

Option Explicit
Option Base 1

Sub Picker()    ' will place 10 random patient numbers into H2:H11
Dim lrow%
lrow = LastRow("VP")
cells(2, 5).FormulaR1C1 = "=RAND()"
Range("e2").AutoFill Destination:=Range("e2:e" & lrow), Type:=xlFillDefault
cells(2, 6).FormulaR1C1 = "=ROW()"
Range("f2").AutoFill Destination:=Range("f2:f" & lrow), Type:=xlFillDefault
Range("g2:h" & lrow).Value = Range("e2:f" & lrow).Value
Worksheets("VP").Sort.SortFields.Clear
Worksheets("VP").Sort.SortFields.Add Key:=Range("g2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Worksheets("VP").Sort
        .SetRange Range("g2:h" & lrow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub Gluc()
Dim Tek, Pat_Iris, Pat_Tek, Pat_OK(1 To 10) As Boolean, PRow%(1 To 10), Lb%, Ub%, i%, j%
'Iris = Array(0, 70, 100, 150, 200, 250, 300, 500, 1000, 2000)   ' not used in code...
Tek = Array(0, 1, 250, 500, 1000)
Lb = LBound(Tek)
Ub = UBound(Tek)
Picker
For i = 1 To 10
    Pat_OK(i) = False
    PRow(i) = cells(i + 1, 8).Value
    Pat_Iris = cells(PRow(i), 2).Value
    If InStr(Pat_Iris, ">") > 0 Then Pat_Iris = 2000    ' convert to number
    Pat_Tek = cells(PRow(i), 3).Value
    If InStr(Pat_Tek, "trace") > 0 Then Pat_Tek = 1     ' convert to number
    ' test if they are the same
    If Pat_Iris = Pat_Tek Then Pat_OK(i) = True
    ' test if Iris matches one of Tek boundaries
    If Not Pat_OK(i) And (Pat_Iris < Tek(Lb) And Pat_Tek = Tek(Lb)) Or _
    (Pat_Iris > Tek(Ub) And Pat_Tek = Tek(Ub)) Then Pat_OK(i) = True
    ' test if Iris matches an intermediate value
    If Not Pat_OK(i) And Pat_Iris >= Tek(Lb) And Pat_Iris <= Tek(Ub) Then
        For j = 1 To (Ub - 1)
            If Pat_Iris >= Tek(j) And Pat_Iris <= Tek(j + 1) Then Exit For
        Next
        If j = 5 Then j = 4         'return to last loop index
        If Pat_Tek = Tek(j) Or Pat_Tek = Tek(j + 1) Then Pat_OK(i) = True
    End If
Next

For i = 1 To 10                     ' write the results
    Select Case Pat_OK(i)
        Case True
            cells(PRow(i), 4).Value = "PASS"
        Case False
            cells(PRow(i), 4).Value = "FAIL"
    End Select
Next
End Sub

Public Function LastRow(which$) As Long
    Sheets(which).Activate
    If WorksheetFunction.CountA(cells) = 0 Then
        LastRow = 0
        Exit Function
    End If
    LastRow = cells.Find(What:="*", After:=[a1], SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious).Row
End Function

 

[vapelata]

Thank you very much