API tools faq
paste
Guest User

Untitled

a guest
Jun 22nd, 2018
79
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 110.90 KB | None | 0 0
raw download clone embed print report
  1. Function FindQC(T As Integer, Info As Integer, DUP As Integer, LFM As Integer) As Variant
  2.  
  3. 'Locates and returns information on QC samples: Project name, sample number, original cell address, T or D, LFM/DUP number (within)
  4. 'T = type of QC. 1 = LFM, 2 = DUP
  5. 'Info = information solicited
  6. ' Info = 1 QC Sample Address(s)
  7. ' = 2 Original Cell address(s) (DUP/LFM)
  8. ' = 3 QC Sample Project name (DUP/LFM)
  9. ' = 4 QC Sample Number (DUP/LFM)
  10. ' = 5 QC Sample Project name and number (DUP/LFM)
  11. ' = 6 QC Cell Length (including spaces)
  12. 'DUP =cells activated, LFM=LFM cells activated
  13.  
  14. Dim QC As String
  15. Dim QC_Num As Integer 'Number of QC Cells
  16. Dim a(1 To 50) As Range 'Addresses of QC Cells
  17. Dim L(1 To 50) As Integer 'Length of QC Cells (for DUPs or LFMs)
  18. Dim QC_Cell(1 To 50) As String 'Content of QC Cells, w/o spaces (for DUPs or LFMs)
  19. Dim Project_Identifier(1 To 50) As String 'First two letters of projects for DUPs or LFMs
  20. Dim QC_Number(1 To 50) As String 'Sample numbers of DUPs or LFMs
  21. Dim TM(1 To 50) As Integer 'Total or dissolved: TM=1, D=0
  22. Dim Orig_a(1 To 50) As Range 'Addresses of Original Cells for DUPs/LFMs
  23. Dim Dilution_Factor(1 To 50) As Double 'Dilution factors of QC_Cell array
  24. 'Dim LFBSpikes() As Double 'Matrix containing list of all LFB spike dates, amount, and concentrations in same order as listed on Spike Values worksheet
  25. Dim LFBDates() As Range
  26. Dim LFBDatesUnion As Range
  27. Dim CurrentDigestSpike As Range
  28. Dim CurrentUndigestSpike As Range
  29. Dim CurrentLFBDate1 As Range
  30. Dim CurrentLFBDate2 As Range
  31. Dim CurrentLFBDate3 As Range
  32. Dim TopRow As Integer 'Might not be necessary, if in sub
  33. Dim BottomRow As Integer
  34. 'ReDim LFBSpikes(1 To 50, 1 To 50) As Double
  35.  
  36. Dim q As Integer, k_1 As Integer, k_2 As Integer, k_3 As Integer, r As Integer, i_0 As Integer, a_0 As Integer, a_1 As Integer 'Counters & dummy variables
  37.  
  38. Color_Pass = Worksheets("Spike Values").Cells(3, 1).Interior.Color
  39. Color_PassF = Worksheets("Spike Values").Cells(3, 1).Font.Color
  40. Color_Accept = Worksheets("Spike Values").Cells(4, 1).Interior.Color
  41. Color_AcceptF = Worksheets("Spike Values").Cells(4, 1).Font.Color
  42. Color_Dilute = Worksheets("Spike Values").Cells(5, 1).Interior.Color
  43. Color_DiluteF = Worksheets("Spike Values").Cells(5, 1).Font.Color
  44. Color_Fail = Worksheets("Spike Values").Cells(6, 1).Interior.Color
  45. Color_FailF = Worksheets("Spike Values").Cells(6, 1).Font.Color
  46.  
  47. For a_1 = 1 To 50
  48. Set a(a_1) = Range("$A$1")
  49. Set Orig_a(a_1) = Range("$A$1")
  50. Next a_1
  51.  
  52. TopRow = Top_Row(1)
  53. BottomRow = Top_Row(2)
  54.  
  55. q = 1
  56. k_1 = 1
  57. k_2 = 1
  58. k_3 = 1
  59.  
  60. If T = 1 Then QC = "DUP"
  61. If T = 2 Then QC = "LFM"
  62. 'If T = 3 Then QC = "LFB"
  63. 'If T = 4 Then QC = "LRB"
  64. 'T=5 ICV ' T >= 3 'Future Addons
  65. 'T=6 CCV 5%
  66. 'T=7 CCV 10%
  67. 'T=8 CCB
  68. 'T=9 SRM
  69.  
  70. For k = TopRow To BottomRow
  71. If InStr(1, Cells(k, 1).Value, QC) <> 0 Then
  72.  
  73. Set a(q) = Range(Cells(k, 1).Address)
  74. q = q + 1
  75.  
  76. End If
  77.  
  78. Next k
  79.  
  80. 'msgbox (a(1) & "_" & a(2) & "_" & a(3) & "_")
  81.  
  82. QC_Num = q - 1
  83.  
  84. If T = 1 Or T = 2 Then
  85. For q = 1 To QC_Num
  86.  
  87. k_1 = 1
  88. k_2 = 1
  89. k_3 = 1
  90.  
  91. L(q) = Len(a(q).Value)
  92. QC_Cell(q) = Replace(a(q).Value, Space(1), Space(0))
  93.  
  94. If Left(UCase(Trim(QC_Cell(q))), 3) = QC Then 'Determines projects for DUPs/LFMs
  95. Project_Identifier(q) = Mid(Trim(UCase(QC_Cell(q))), 4, 2)
  96. Else:
  97. Project_Identifier(q) = Left(Trim(UCase(QC_Cell(q))), 2)
  98. End If
  99.  
  100. Do Until IsNumeric(Mid(a(q).Value, k_1, 1)) = True 'Finds sample numbers of DUPs/LFMs
  101. k_1 = k_1 + 1
  102. Loop
  103.  
  104. k_2 = k_1
  105. Do Until IsNumeric(Mid(a(q).Value, k_2, 1)) = False And InStr(1, Mid(a(q).Value, k_2, 1), ".") = 0 '_
  106. 'And InStr(1, Mid(a(q).Value, k_2, 1), " ") = 0 And InStr(1, Mid(a(q).Value, k_2, 1), "-") = 0 And (InStr(1, Mid(a(q).Value, k_2, 1), "x") = 0 _
  107. 'Or InStr(1, Mid(a(q).Value, k_2, 1), "X") Or InStr(1, Mid(a(q).Value, k_2, 1), "\") Or InStr(1, Mid(a(q).Value, k_2, 1), "/") Or InStr(1, Mid(a(q).Value, k_2, 1), "-"))
  108. k_2 = k_2 + 1
  109. Loop
  110.  
  111. QC_Number(q) = Trim(Mid(a(q).Value, k_1, k_2 - k_1))
  112. TM(q) = TM_Check(a(q), 0)
  113.  
  114. Dilution_Factor(q) = Dilution(1, a(q))
  115.  
  116.  
  117. Next q
  118.  
  119. For r = TopRow To BottomRow
  120. If Cells(r, 1).Value <> "" Then
  121. For q = 1 To QC_Num
  122.  
  123.  
  124. If InStr(1, Replace(Cells(r, 1).Value, Space(1), Space(0)), QC_Number(q)) <> 0 And InStr(1, Cells(r, 1).Value, " " & QC_Number(q)) <> 0 And Left(Trim(Cells(r, 1).Value), 2) = Project_Identifier(q) _
  125. And a(q).Address <> Cells(r, 1).Address And TM_Check(Range(Cells(r, 1).Address), 0) = TM(q) And InStr(1, Cells(r, 1).Value, "DUP") = 0 _
  126. And InStr(1, Cells(r, 1).Value, "LFM") = 0 And Dilution_Factor(q) = Dilution(1, Range(Cells(r, 1).Address)) Then
  127.  
  128.  
  129. Set Orig_a(q) = Range(Cells(r, 1).Address)
  130. 'msgbox (Range(Orig_a(q)).Value & "=" & QC_Cell(q))
  131.  
  132. Else:
  133. If InStr(1, Replace(Cells(r, 1).Value, Space(1), Space(0)), QC_Number(q)) <> 0 And InStr(1, Cells(r, 1).Value, " " & QC_Number(q)) <> 0 And Left(Trim(Cells(r, 1).Value), 2) = Project_Identifier(q) _
  134. And a(q).Address <> Cells(r, 1).Address And TM_Check(Range(Cells(r, 1).Address), 0) = TM(q) And InStr(1, Cells(r, 1).Value, "DUP") = 0 _
  135. And InStr(1, Cells(r, 1).Value, "LFM") = 0 And QC <> "DUP" And Dilution_Factor(q) > Dilution(1, Range(Cells(r, 1).Address)) Then
  136.  
  137. Set Orig_a(q) = Range(Cells(r, 1).Address) 'DilutionLFM > DilutionOrig, set orig
  138.  
  139. End If
  140. End If
  141.  
  142.  
  143. Next q
  144. q = 1
  145. End If
  146.  
  147. Next r
  148. If r = 501 Then Set Orig_a(q) = Range("$A$1")
  149.  
  150. 'For q = 1 To 3
  151. ' msgbox (Orig_a(q))
  152. ' msgbox (QC_Cell(q))
  153. 'Next q
  154.  
  155. End If
  156.  
  157. If Info = 1 Then
  158. FindQC = a()
  159. End If
  160.  
  161. If Info = 2 Then
  162. FindQC = Orig_a()
  163. End If
  164.  
  165. If Info = 3 Then
  166. FindQC = Project_Identifier()
  167. End If
  168. If Info = 4 Then
  169. FindQC = QC_Number()
  170. End If
  171. If Info = 5 Then
  172. FindQC = QC_Cell()
  173. End If
  174. If Info = 6 Then
  175. FindQC = L()
  176. End If
  177.  
  178. ' Info = 1 QC Sample Address(s)
  179. ' = 2 Original Cell address(s) (DUP/LFM)
  180. ' = 3 QC Sample Project name (DUP/LFM)
  181. ' = 4 QC Sample Number (DUP/LFM)
  182. ' = 5 QC Sample Project name and number (DUP/LFM)
  183.  
  184.  
  185.  
  186.  
  187.  
  188. 'Non LFM/DUP QC: For q =1 to QC_Num /loop
  189.  
  190. If T = 3 Then
  191.  
  192. 'Make list of current LFB spikes available
  193.  
  194. 'Do Until Cells(j, 1).Value = ""
  195. '
  196. ' Set LFBSpikeList(j) = Cells(j, 1).Address
  197. '
  198. ' j = j + 1
  199. 'Loop
  200.  
  201.  
  202. If UCase(Worksheets("Spike Values").Cells(12, 1).Value) = "LFB" Or LCase(Worksheets("Spike Values").Cells(12, 1).Value) = "laboratory fortified matrix" Then
  203.  
  204. If (InStr(1, Worksheets("Spike Values").Cells(12, 2).Value, "LFB 1") <> 0 And InStr(1, Worksheets("Spike Values").Cells(12, 4).Value, "LFB 2") <> 0) Then
  205. Set CurrentLFBDate1 = Worksheets("Spike Values").Range("$C$12")
  206. Set CurrentLFBDate2 = Worksheets("Spike Values").Range("$E$12")
  207. If InStr(1, Worksheets("Spike Values").Cells(12, 6).Value, "LFB 3") <> 0 Then Set CurrentLFBDate3 = Worksheets("Spike Values").Range("$G$12")
  208.  
  209. Else:
  210. If InStr(1, Worksheets("Spike Values").Cells(12, 2).Value, "LFB 2") <> 0 And InStr(1, Worksheets("Spike Values").Cells(12, 4).Value, "LFB 1") <> 0 Then
  211. Set CurrentLFBDate1 = Worksheets("Spike Values").Range("$E$12")
  212. Set CurrentLFBDate2 = Worksheets("Spike Values").Range("$C$12")
  213. If InStr(1, Worksheets("Spike Values").Cells(12, 6).Value, "LFB 3") <> 0 Then Set CurrentLFBDate3 = Worksheets("Spike Values").Range("$G$12")
  214.  
  215. Else:
  216. msg = msgbox("Please input current LFB spike dates used in 'Spike Values' sheet", vbCritical)
  217. End If
  218.  
  219. End If
  220.  
  221. Else:
  222.  
  223. For i = 10 To 21
  224.  
  225. If InStr(1, Worksheets("Spike Values").Cells(i, 1).Value, "LFB") <> 0 Then
  226.  
  227. Exit For
  228.  
  229. End If
  230.  
  231. Next i
  232.  
  233. If i = 21 Then
  234. msg = msgbox("Please input current LFB spikes used in 'Spike Values' sheet", vbCritical)
  235. Else:
  236.  
  237. If (InStr(1, Worksheets("Spike Values").Cells(i, 2).Value, "LFB 1") <> 0 And InStr(1, Worksheets("Spike Values").Cells(i, 4).Value, "LFB 2") <> 0) Then
  238. Set CurrentLFBDate1 = Worksheets("Spike Values").Range(Cells(i, 3).Address)
  239. Set CurrentLFBDate2 = Worksheets("Spike Values").Range(Cells(i, 5).Address)
  240. If InStr(1, Worksheets("Spike Values").Cells(i, 6).Value, "LFB 3") <> 0 Then Set CurrentLFBDate3 = Worksheets("Spike Values").Range(Cells(i, 6).Address)
  241.  
  242.  
  243. Else:
  244. If InStr(1, Worksheets("Spike Values").Cells(i, 2).Value, "LFB 2") <> 0 And InStr(1, Worksheets("Spike Values").Cells(i, 4).Value, "LFB 1") <> 0 Then
  245. Set CurrentLFBDate1 = Worksheets("Spike Values").Range(Cells(i, 5).Address)
  246. Set CurrentLFBDate2 = Worksheets("Spike Values").Range(Cells(i, 3).Address)
  247. If InStr(1, Worksheets("Spike Values").Cells(i, 6).Value, "LFB 3") <> 0 Then Set CurrentLFBDate3 = Worksheets("Spike Values").Range(Cells(i, 6).Address)
  248.  
  249. Else:
  250. msg = msgbox("Please input current LFB spikes used in 'Spike Values' sheet", vbCritical)
  251. End If
  252. End If
  253. End If
  254. End If
  255.  
  256. i_0 = 1
  257.  
  258.  
  259. 'Find LFB Spikes on list: Search I=23 on to find correct LFB spike date
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266. For k = 1 To QC_Num
  267.  
  268. 'Invoke a(k); divide a(k).value by LFBspikedate_row found above
  269.  
  270.  
  271. If a(k).Value = "LFB 1" Then
  272.  
  273. i_3 = 23
  274.  
  275. Do
  276.  
  277. If CurrentLFBDate1 = Worksheets("Spike Values").Cells(i_3, 3) Then 'Fix formatting: need consistent date values!''''''''''''''''''''''''
  278.  
  279. CurrentLFBSpike1 = Worksheets("Spike Values").Cells(i_3, 4).Address
  280. Exit Do 'Check command!
  281.  
  282. End If
  283. Loop While Worksheets("Spike Values").Cells(i_3, 1) <> ""
  284.  
  285.  
  286. End If
  287.  
  288. If a(k).Value = "LFB 2" Then
  289. i_3 = 23
  290.  
  291. Do
  292.  
  293. If CurrentLFBDate2 = Worksheets("Spike Values").Cells(i_3, 3) Then 'Fix formatting: need consistent date values!''''''''''''''''''''''''
  294.  
  295. CurrentLFBSpike2 = Worksheets("Spike Values").Cells(i_3, 4).Address
  296. Exit Do 'Check command!
  297.  
  298. End If
  299. Loop While Worksheets("Spike Values").Cells(i_3, 1) <> ""
  300.  
  301.  
  302. End If
  303.  
  304.  
  305. For a_0 = 2 To 50
  306. 'a_1=1 Spike
  307. 'a_1=2 Percent Spike (Usually 0.1)
  308. 'a_1=3 Date of LFB spike
  309. 'a_1>3 Spike values
  310.  
  311. ' If Worksheet.Cells(1, a_0).Value = "" Then Exit For
  312.  
  313. ' For a_1 = 3 To 50
  314. '
  315. ' If Worksheet.Cells(22, a_1).Value = "" Then Exit For
  316. '
  317. ' If Replace(UCase(Left(Worksheet.Cells(1, a_0).Value, 2)), Space(1), Space(0)) = Replace(UCase(Left(Worksheet.Cells(22, a_1).Value, 2)), Space(1), Space(0)) Then
  318. '
  319. '
  320. '
  321. ' Exit For
  322. ' End If
  323.  
  324.  
  325.  
  326. '
  327. '
  328. '
  329. '
  330. '
  331. '
  332. '
  333.  
  334. If Worksheets("Spike Values").Cells(a_0 + 22, 1).Value = "" Then Exit For
  335.  
  336. a_3 = 0
  337.  
  338.  
  339. If UCase(Worksheets("Spike Values").Cells(a_0 + 22, 1).Value) = "LFB" Then
  340.  
  341.  
  342.  
  343. If a_3 = 1 Or a_3 = 2 Or a_3 = 3 Then
  344.  
  345. For a_1 = 2 To 50
  346.  
  347. If Worksheets("Spike Values").Cells(a_0 + 22, a_1).Value = "" Then Exit For
  348.  
  349. If DateValue(CurrentLFBDate1.Value) = DateValue(Worksheets("Spike Values").Cells(a_0 + 22, 1).Value) Then
  350.  
  351. For n_1 = 2 To 50
  352.  
  353. For n_2 = 4 To 50
  354.  
  355. If Replace(Left(Cells(1, n_1).Value, 2), Space(1), Space(0)) = Left(Worksheets("Spike Values").Cells(22, n_2), 2) Then
  356. If Worksheets("Spike Values").Cells(a_0 + 22, 1).Value <> 0 Then
  357. If Cells(a(k).Row, n_1).Value / Worksheets("Spike Values").Cells(a_0 + 22, 1).Value > 0.85 And Cells(a(k).Row, n_1).Value / Worksheets("Spike Values").Cells(a_0 + 22, 1).Value < 1.15 Then
  358. Cells(a(k).Row, n_1).Interior.Color = Color_Pass
  359. Cells(a(k).Row, n_1).Font.Color = Color_PassF
  360. Else:
  361. Cells(a(k).Row, n_1).Interior.Color = Color_Fail
  362. Cells(a(k).Row, n_1).Font.Color = Color_FailF
  363.  
  364. End If
  365. Else:
  366. Cells(a(k).Row, n_1).Interior.Color = Color_Dilute
  367. Cells(a(k).Row, n_1).Font.Color = Color_DiluteF
  368.  
  369. End If
  370. End If
  371. Next n_2
  372. Next n_1
  373.  
  374. End If
  375.  
  376. If DateValue(CurrentLFBDate2.Value) = DateValue(Worksheets("Spike Values").Cells(a_0 + 22, 1).Value) Then
  377.  
  378. End If
  379.  
  380. If DateValue(CurrentLFBDate3.Value) = DateValue(Worksheets("Spike Values").Cells(a_0 + 22, 1).Value) Then
  381.  
  382. End If
  383.  
  384.  
  385. If a_1 = 3 Then
  386. 'LFBSpikes(a_3, a_1) = DateValue(Worksheets("Spike Values").Cells(a_0 + 22, a_1).Value)
  387.  
  388.  
  389. ''Set LFBDates(a_0) = Range(Worksheets("Spike Values").Cells(a_0 + 22, a_1).Address)
  390. 'Worksheets("Spike Values").Cells(i_0, 15).Value = "LFB 1" & Worksheets("Spike Values").Cells(a_0 + 22, a_1).Value
  391. 'Worksheets("Spike Values").Cells(i_0, 16).Value = "LFB 2" & Worksheets("Spike Values").Cells(a_0 + 22, a_1).Value
  392. i_0 = i_0 + 1
  393. Else:
  394. ' LFBSpikes(a_3, a_1) = Worksheets("Spike Values").Cells(a_0 + 22, a_1).Value
  395. End If
  396. Next a_1
  397. End If
  398. End If
  399. Next a_0
  400.  
  401. Next k
  402.  
  403.  
  404. End If
  405. End Function
  406.  
  407.  
  408.  
  409.  
  410. Function TM_Check(C As Range, E As Integer) As Integer
  411. 'Checks if given cell is total or dissolved
  412. 'C = Cell address
  413. 'E = Explicit
  414. ' E=0 Dissolved samples implicit: e.g. "TOLL 3507" v. "TOLL 3507 TM"
  415. ' E=1 Dissolved samples explicitly indicated in sample title: e.g. "TOLL 3507 D" v. "TOLL 3507 T"
  416. 'TM_Check=0 Dissolved
  417. 'TM_Check=1 Total
  418.  
  419. If (E = 0 Or IsEmpty(E) = True) And C.Value <> "" Then
  420.  
  421. If InStr(1, UCase(C.Value), "TM") <> 0 Or (InStr(1, UCase(C.Value), "TOT") <> 0 And Left(UCase(C.Value), 3) = "TOT") Then
  422. TM_Check = 1
  423. Else:
  424. TM_Check = 0
  425. End If
  426.  
  427. End If
  428.  
  429.  
  430. If E = 1 And C.Value <> "" Then
  431. k_1 = 1
  432. k_2 = 1
  433.  
  434. Do Until IsNumeric(Mid(C.Value, k_1, 1)) = True 'Finds sample numbers of DUPs/LFMs
  435. k_1 = k_1 + 1
  436. Loop
  437. k_2 = k_1
  438. Do Until IsNumeric(Mid(C.Value, k_2, 1)) = False And InStr(1, Mid(C.Value, k_2, 1), ".") = 0
  439. k_2 = k_2 + 1
  440. Loop
  441.  
  442. Do Until IsEmpty(TM_Check) = False Or k_2 = 100
  443. If InStr(k_2, C.Value, "D") <> 0 And InStr(k_2, C.Value, "T") = 0 Then
  444. TM_Check = 1
  445.  
  446. Else:
  447. If InStr(k_2, C.Value, "T") <> 0 Then TM_Check = 0
  448.  
  449. End If
  450. k_2 = k_2 + 1
  451. Loop
  452.  
  453. End If
  454.  
  455. If C.Value = "" Then TM_Check = 0
  456.  
  457. End Function
  458.  
  459. Function Dilution(T As Integer, C As Range) As Double
  460.  
  461. 'T= Type
  462. ' 1=Checks if sample is dilution based on sample ID and outputs dilution factor(s)
  463. ' 2=Checks whether sample requires or has been diluted for whole spreadsheet based on data (T=2 defunct: see Dilutions() function for this feature)
  464. ' 3=
  465. 'C= Cell address (if T=1)
  466. 'C=0 If T=2
  467.  
  468. Dim DF As Double
  469. Dim TopRow As Integer 'Start of data; not to be confused with Top_Row()
  470. Dim NumStandards As Integer 'Number of Standards
  471. 'Dim ElementP_2(1 To 50) As String
  472. Dim StandardRange As String, High_Standard As String 'Element_2 prime: 2 refers to data in lower half of spread sheet; 1 refers to information at top of spreadsheet; prime refers to the redunant inclusion of dual-wavelength elements
  473. Dim i As Integer, k_1 As Integer, k_2 As Integer, k_3 As Integer, E As Integer, m As Integer
  474.  
  475.  
  476. k_1 = 1
  477. k_2 = 1
  478. k_3 = 1
  479.  
  480.  
  481. 'If T = 1 Then
  482.  
  483. Dilution = 1
  484.  
  485. If C <> Range("$A$1").Address Then
  486.  
  487. If InStr(1, Mid(UCase(C.Value), k_2), "X") <> 0 And (IsNumeric(InStr(1, Mid(UCase(C.Value), k_2), "X") + 1) = True Or IsNumeric(InStr(1, Mid(UCase(C.Value), k_2), "X") + 2) = True) Then
  488.  
  489. k_1 = InStr(1, Mid(UCase(C.Value), k_2), "X")
  490. k_2 = 1
  491. k_3 = 1
  492.  
  493. ' msgbox (Mid(UCase(Range(C).Value), k_2))
  494.  
  495. Do Until IsNumeric(Mid(C.Value, k_1, 1)) = True 'FIX!
  496. ' msgbox (Mid(Range(C).Value, k_1, 1))
  497. k_1 = k_1 + 1
  498.  
  499. Loop
  500. ' msgbox (Mid(Range(C).Value, k_1, 1))
  501. k_2 = k_1
  502. Do Until IsNumeric(Mid(C.Value, k_2, 1)) = False And InStr(Mid(C.Value, k_2, 1), ".") = 0
  503. ' msgbox (Mid(Range(C).Value, k_2, 1))
  504. k_2 = k_2 + 1
  505. Loop
  506. ' msgbox (Mid(Range(C).Value, k_2, 1))
  507. k_3 = k_2
  508. ' Do Until IsNumeric(Mid(Range(C).Value, k_2, k_3)) = False And InStr(Mid(Range(C).Value, k_2, k_3), ".") <> 0 'FIX!
  509. ' msgbox (Mid(Range(C).Value, k_2, k_3))
  510. ' k_3 = k_3 + 1
  511. ' Loop
  512. ' msgbox (Mid(Range(C).Value, k_2, k_3))
  513. ' msgbox (Mid(Range(C).Value, k_1, k_2 - k_1))
  514. Dilution = Mid(C.Value, k_1, k_2 - k_1)
  515.  
  516. End If
  517.  
  518.  
  519. If InStr(1, Mid(UCase(C.Value), k_2), "/") <> 0 And (IsNumeric(InStr(1, Mid(UCase(C.Value), k_2), "/") + 1) = True Or IsNumeric(InStr(1, Mid(UCase(C.Value), k_2), "/") + 2) = True) Then
  520.  
  521. k_1 = InStr(1, Mid(UCase(C.Value), k_2), "/")
  522. k_2 = 1
  523. k_3 = 1
  524.  
  525. Do Until IsNumeric(Mid(C.Value, k_1, 1)) = True
  526. k_1 = k_1 + 1
  527. Loop
  528. k_2 = k_1
  529. Do Until IsNumeric(Mid(C.Value, k_2, 1)) = False And InStr(Mid(C.Value, k_2, 1), ".") = 0
  530. k_2 = k_2 + 1
  531. Loop
  532. ' k_3 = k_2
  533. ' Do Until IsNumeric(Mid(Range(C).Value, k_2, k_3)) = False And InStr(Mid(Range(C).Value, k_2, k_3), ".") <> 0
  534. ' k_3 = k_3 + 1
  535. ' Loop
  536.  
  537. Dilution = Mid(C.Value, k_1, k_2 - k_1)
  538.  
  539. End If
  540.  
  541. If InStr(1, Mid(UCase(C.Value), k_2), "\") <> 0 And (IsNumeric(InStr(1, Mid(UCase(C.Value), k_2), "\") + 1) = True Or IsNumeric(InStr(1, Mid(UCase(C.Value), k_2), "\") + 2) = True) Then
  542.  
  543. k_1 = InStr(1, Mid(UCase(C.Value), k_2), "\")
  544. k_2 = 1
  545. k_3 = 1
  546.  
  547. Do Until IsNumeric(Mid(C.Value, k_1, 1)) = True
  548. k_1 = k_1 + 1
  549. Loop
  550. k_2 = k_1
  551. Do Until IsNumeric(Mid(C.Value, k_2, 1)) = False And InStr(Mid(C.Value, k_2, 1), ".") = 0
  552. k_2 = k_2 + 1
  553. Loop
  554. ' k_3 = k_2
  555. ' Do Until IsNumeric(Mid(Range(C).Value, k_2, k_3)) = False And InStr(Mid(Range(C).Value, k_2, k_3), ".") <> 0
  556. ' k_3 = k_3 + 1
  557. ' Loop
  558.  
  559. Dilution = Mid(C.Value, k_1, k_2 - k_1)
  560.  
  561. End If
  562.  
  563. If (InStr(1, Mid(UCase(C.Value), k_2), "X") <> 0 And (IsNumeric(InStr(1, Mid(UCase(C.Value), k_2), "X") + 1) = True Or IsNumeric(InStr(1, Mid(UCase(C.Value), k_2), "X") + 2) = True)) And (InStr(1, Mid(UCase(C.Value), k_2), "/") <> 0 And (IsNumeric(InStr(1, Mid(UCase(C.Value), k_2), "/") + 1) = True Or IsNumeric(InStr(1, Mid(UCase(C.Value), k_2), "/") + 2) = True)) And (InStr(1, Mid(UCase(C.Value), k_2), "\") <> 0 And (IsNumeric(InStr(1, Mid(UCase(C.Value), k_2), "\") + 1) = True Or IsNumeric(InStr(1, Mid(UCase(C.Value), k_2), "\") + 2) = True)) Then
  564. Dilution = 1 'Doesn't make sense
  565. End If
  566.  
  567.  
  568. End If
  569. 'End if
  570.  
  571. End Function
  572.  
  573. Function Dilutions(T As Integer) As Variant
  574.  
  575. Dim DF As Double
  576. Dim TopRow As Integer 'Start of data; not to be confused with Top_Row()
  577. Dim NumStandards As Integer 'Number of Standards
  578. 'Dim ElementP_2(1 To 50) As String
  579. Dim StandardRange As String, High_Standard As Double 'Element_2 prime: 2 refers to data in lower half of spread sheet; 1 refers to information at top of spreadsheet; prime refers to the redunant inclusion of dual-wavelength elements
  580. Dim i As Integer, k_1 As Integer, k_2 As Integer, k_3 As Integer, E As Integer, m As Integer
  581. Dim ISTD(1 To 2) As String
  582. Worksheets("Dilutions").UsedRange.ClearContents
  583.  
  584.  
  585. Dim Two_Wavelength_Elements() As String
  586. Dim Extraneous(1 To 5) As String
  587. ReDim Two_Wavelength_Elements(1 To 15) As String
  588.  
  589.  
  590. NumberDualWavelength = 0
  591. i_0 = 3
  592. i_2 = 0
  593.  
  594. Do Until Worksheets("Spike Values").Cells(3, i_0) = ""
  595. i_1 = i_0 - 2
  596. Two_Wavelength_Elements(i_1) = Worksheets("Spike Values").Cells(3, i_0)
  597. NumberDualWavelength = NumberDualWavelength + 1
  598. i_0 = i_0 + 1
  599. Loop
  600.  
  601. i_0 = 3
  602.  
  603. For i_1 = 1 To 5
  604. i_0 = i_1 + 2
  605. Extraneous(i_1) = Worksheets("Spike Values").Cells(7, i_0)
  606. Next i_1
  607.  
  608. 'Do Until Worksheets("Spike Values").Cells(7, i_0) = ""
  609. ' i_1 = i_0 - 2
  610. ' Extraneous(i_1) = Worksheets("Spike Values").Cells(7, i_0)
  611. ' i_0 = i_0 + 1
  612. ' i_2 = i_2 + 1
  613. 'Loop
  614.  
  615. ReDim Preserve Two_Wavelength_Elements(1 To NumberDualWavelength) As String
  616.  
  617. ISTD(1) = Worksheets("Spike Values").Cells(5, 3)
  618. ISTD(2) = Worksheets("Spike Values").Cells(5, 4)
  619.  
  620. 'Two_Wavelength_Elements(1) = "Ca"
  621. 'Two_Wavelength_Elements(2) = "Mg"
  622. 'Two_Wavelength_Elements(3) = "Na"
  623. 'Two_Wavelength_Elements(4) = "P"
  624. 'Two_Wavelength_Elements(5) = "S"
  625.  
  626.  
  627. If T = 2 Then
  628.  
  629.  
  630. 'msgbox ("test")
  631. TopRow = Top_Row(1)
  632. BottomRow = Top_Row(2)
  633. 'TopRow=Top_Row(1)
  634.  
  635. Do Until InStr(1, Cells(TopRow + 2 + i, 1).Value, "Standard") = 0
  636. i = i + 1
  637. Loop
  638. j = i
  639. Do Until InStr(1, Cells(TopRow + 2 + j, 1).Value, "Calib") = 0
  640. j = j + 1
  641. Loop
  642. NumStandards = i + 1
  643.  
  644. Do Until InStr(1, Cells(j - 1, 1).Value, "Cont Calib Verif LO 5%") <> 0 And InStr(1, Cells(j, 1).Value, "Cont Calib Verif HI 5%") <> 0
  645. j = j + 1 'Check for off-by-one error
  646. Loop
  647.  
  648. j = j + 1
  649. FirstSampleRow = j
  650.  
  651. ' Sheets.Add.Name = "Dilutions"
  652. ' .Visible = xlSheetVeryHidden
  653. ' 'Copy and paste worksheets("PSL") from Top_Row down
  654.  
  655.  
  656.  
  657. m = 2
  658.  
  659. Do Until m > 100 Or Cells(TopRow, m).Value = "" '100 = arbitrary large number as upper limit of measured wavelengths
  660.  
  661. For E = 1 To NumberDualWavelength
  662.  
  663. If Two_Wavelength_Elements(E) = Replace(Left(Cells(TopRow, m).Value, 2), Space(1), Space(0)) Then Exit For
  664.  
  665. Next E
  666.  
  667.  
  668. If _
  669. Replace(Left(Cells(TopRow, m).Value, 2), Space(1), Space(0)) <> ISTD(1) And _
  670. Replace(Left(Cells(TopRow, m).Value, 2), Space(1), Space(0)) <> ISTD(2) And _
  671. Replace(UCase(Cells(TopRow, m).Value), Space(1), Space(0)) <> Replace(UCase(Extraneous(1)), Space(1), Space(0)) And _
  672. Replace(UCase(Cells(TopRow, m).Value), Space(1), Space(0)) <> Replace(UCase(Extraneous(2)), Space(1), Space(0)) And _
  673. Replace(UCase(Cells(TopRow, m).Value), Space(1), Space(0)) <> Replace(UCase(Extraneous(3)), Space(1), Space(0)) And _
  674. Replace(UCase(Cells(TopRow, m).Value), Space(1), Space(0)) <> Replace(UCase(Extraneous(4)), Space(1), Space(0)) And _
  675. Replace(UCase(Cells(TopRow, m).Value), Space(1), Space(0)) <> Replace(UCase(Extraneous(5)), Space(1), Space(0)) Then
  676.  
  677.  
  678. If E = NumberDualWavelength + 1 Then
  679. 'Single-wavelength dilution check
  680.  
  681. 'TODO: Add subroutine for QC error flags (e.g. parsing QC flag letters after values)
  682.  
  683.  
  684. StandardRange = Cells(TopRow + 1, m).Address & ":" & Cells(TopRow + NumStandards, m).Address
  685.  
  686. High_Standard = Application.Max(Range(StandardRange))
  687.  
  688. Do Until j = BottomRow
  689.  
  690. DF = Dilution(1, Cells(j, 1))
  691.  
  692. If IsNumeric(Cells(j, m).Value) = False Then
  693.  
  694. Worksheets("Dilutions").Range(Cells(j, m).Address).Value = 2
  695.  
  696. Else
  697.  
  698. 'msgbox (Cells(j, m).Value / DF)
  699. 'msgbox (TypeName(High_Standard))
  700. 'msgbox ((Cells(j, m).Value / DF) < High_Standard)
  701. If DF <> 0 And Cells(j, m).Value / DF < High_Standard Then 'Math checked
  702. If DF <= 1 Then Worksheets("Dilutions").Range(Cells(j, m).Address).Value = 0
  703. If DF > 1 Then Worksheets("Dilutions").Range(Cells(j, m).Address).Value = 3
  704.  
  705. Else
  706. Worksheets("Dilutions").Range(Cells(j, m).Address).Value = 2
  707. End If
  708.  
  709. End If
  710.  
  711. j = j + 1
  712.  
  713. Loop
  714.  
  715. j = FirstSampleRow
  716.  
  717. Else:
  718. 'Dual wavelength dilution check
  719.  
  720. If Replace(Left(Cells(TopRow, m).Value, 2), Space(1), Space(0)) = Replace(Left(Cells(TopRow, m + 1).Value, 2), Space(1), Space(0)) Then
  721.  
  722. StandardRange = Cells(TopRow + 1, m).Address & ":" & Cells(TopRow + NumStandards, m + 1).Address
  723. StandardRange_1 = Cells(TopRow + 1, m).Address & ":" & Cells(TopRow + NumStandards, m).Address
  724. StandardRange_2 = Cells(TopRow + 1, m + 1).Address & ":" & Cells(TopRow + NumStandards, m + 1).Address
  725.  
  726.  
  727. If Application.Max(Range(StandardRange_1)) > Application.Max(Range(StandardRange_2)) Then 'Syntax?
  728.  
  729. StandardRangeLO_CONC = StandardRange_2
  730. ColumnLO_CONC = m + 1
  731. If j = FirstSampleRow Then Worksheets("Dilutions").Range(Cells(TopRow - 1, m + 1).Address).Value = "LOW" ''''''
  732. StandardRangeHI_CONC = StandardRange_1
  733. ColumnHI_CONC = m
  734. If j = FirstSampleRow Then Worksheets("Dilutions").Range(Cells(TopRow - 1, m).Address).Value = "HIGH" ''''''
  735. High_StandardHI_CONC = Application.Max(Range(StandardRange_1))
  736. High_StandardLO_CONC = Application.Max(Range(StandardRange_2))
  737.  
  738. Low_StandardHI_CONC = Application.Min(Range(StandardRangeHI_CONC)) 'revise Low_StandardHI_CONC definition
  739.  
  740. If High_StandardLO_CONC + 1 >= Low_StandardHI_CONC Then
  741.  
  742. Low_StandardHI_CONC = Application.Max(Range(StandardRangeLO_CONC)) 'revise Low_StandardHI_CONC definition
  743.  
  744. Else:
  745. Low_StandardHI_CONC = Application.Min(Range(StandardRangeHIGH_CONC)) 'revise Low_StandardHI_CONC definition
  746. End If
  747.  
  748. Else:
  749.  
  750. If Application.Max(Range(StandardRange_1)) < Application.Max(Range(StandardRange_2)) Then
  751.  
  752. StandardRangeLO_CONC = StandardRange_1
  753. ColumnLO_CONC = m
  754. If j = FirstSampleRow Then Worksheets("Dilutions").Range(Cells(TopRow - 1, m).Address).Value = "LOW" ''''''
  755. StandardRangeHI_CONC = StandardRange_2
  756. ColumnHI_CONC = m + 1
  757. If j = FirstSampleRow Then Worksheets("Dilutions").Range(Cells(TopRow - 1, m + 1).Address).Value = "HIGH" ''''''
  758. High_StandardHI_CONC = Application.Max(Range(StandardRange_2))
  759. High_StandardLO_CONC = Application.Max(Range(StandardRange_1))
  760. Low_StandardHI_CONC = Application.Min(Range(StandardRange_2)) 'revise Low_StandardHI_CONC definition
  761.  
  762.  
  763. Low_StandardHI_CONC = Application.Min(Range(StandardRangeHI_CONC))
  764. If High_StandardLO_CONC + 1 >= Low_StandardHI_CONC Then
  765.  
  766. Low_StandardHI_CONC = Application.Max(Range(StandardRangeLO_CONC)) 'revise Low_StandardHI_CONC definition
  767.  
  768. Else:
  769. Low_StandardHI_CONC = Application.Min(Range(StandardRangeHIGH_CONC)) 'revise Low_StandardHI_CONC definition
  770. End If
  771.  
  772. End If
  773. End If
  774.  
  775.  
  776. Do Until j = BottomRow
  777.  
  778. DF = Dilution(1, Cells(j, 1))
  779. If IsNumeric(Cells(j, ColumnLO_CONC).Value) = False And IsNumeric(Cells(j, ColumnHI_CONC).Value) = False Then
  780. Worksheets("Dilutions").Range(Cells(j, ColumnLO_CONC).Address).Value = 2
  781. Worksheets("Dilutions").Range(Cells(j, ColumnHI_CONC).Address).Value = 2
  782. End If
  783.  
  784. If IsNumeric(Cells(j, ColumnLO_CONC).Value) = False And IsNumeric(Cells(j, ColumnHI_CONC).Value) = True Then
  785.  
  786. If Cells(j, ColumnHI_CONC).Value <= High_StandardHI_CONC And Cells(j, ColumnHI_CONC).Value >= Low_StandardHI_CONC And DF <= 1 Then
  787. Worksheets("Dilutions").Range(Cells(j, ColumnLO_CONC).Address).Value = -1
  788. Worksheets("Dilutions").Range(Cells(j, ColumnHI_CONC).Address).Value = 0
  789. Else
  790. If DF > 1 And Cells(j, ColumnHI_CONC).Value / DF <= High_StandardHI_CONC And Cells(j, ColumnHI_CONC).Value / DF >= Low_StandardHI_CONC Then
  791. Worksheets("Dilutions").Range(Cells(j, ColumnLO_CONC).Address).Value = -1
  792. Worksheets("Dilutions").Range(Cells(j, ColumnHI_CONC).Address).Value = 3
  793. Else
  794. Worksheets("Dilutions").Range(Cells(j, ColumnLO_CONC).Address).Value = 2
  795. Worksheets("Dilutions").Range(Cells(j, ColumnHI_CONC).Address).Value = 2
  796. End If
  797. End If
  798. End If
  799.  
  800. If IsNumeric(Cells(j, ColumnLO_CONC).Value) = True And IsNumeric(Cells(j, ColumnHI_CONC).Value) = False Then
  801. If DF <= 1 Then
  802. Worksheets("Dilutions").Range(Cells(j, ColumnLO_CONC).Address).Value = 0
  803. Worksheets("Dilutions").Range(Cells(j, ColumnHI_CONC).Address).Value = -1
  804. Else
  805. Worksheets("Dilutions").Range(Cells(j, ColumnLO_CONC).Address).Value = 3
  806. Worksheets("Dilutions").Range(Cells(j, ColumnHI_CONC).Address).Value = -1
  807. End If
  808. End If
  809.  
  810. If IsNumeric(Cells(j, ColumnLO_CONC).Value) = True And IsNumeric(Cells(j, ColumnHI_CONC).Value) = True Then
  811. If DF <= 1 Then
  812. If Cells(j, ColumnLO_CONC).Value <= High_StandardLO_CONC And Cells(j, ColumnHI_CONC).Value < Low_StandardHI_CONC Then 'FIXED
  813. Worksheets("Dilutions").Range(Cells(j, ColumnLO_CONC).Address).Value = 0
  814. Worksheets("Dilutions").Range(Cells(j, ColumnHI_CONC).Address).Value = -1
  815. End If
  816.  
  817. If Cells(j, ColumnLO_CONC).Value > High_StandardLO_CONC And Cells(j, ColumnHI_CONC).Value >= Low_StandardHI_CONC Then 'FIXED
  818. Worksheets("Dilutions").Range(Cells(j, ColumnLO_CONC).Address).Value = -1
  819. Worksheets("Dilutions").Range(Cells(j, ColumnHI_CONC).Address).Value = 0
  820. End If
  821.  
  822. If Cells(j, ColumnLO_CONC).Value > High_StandardLO_CONC And Cells(j, ColumnHI_CONC).Value < Low_StandardHI_CONC Then 'CHECKED
  823.  
  824. If Low_StandardHI_CONC <= High_StandardLO_CONC Then 'Check logic
  825.  
  826. Worksheets("Dilutions").Range(Cells(j, ColumnLO_CONC).Address).Value = 5
  827. Worksheets("Dilutions").Range(Cells(j, ColumnHI_CONC).Address).Value = 5
  828.  
  829. Else:
  830.  
  831. Worksheets("Dilutions").Range(Cells(j, ColumnLO_CONC).Address).Value = 2
  832. Worksheets("Dilutions").Range(Cells(j, ColumnHI_CONC).Address).Value = 2
  833.  
  834. End If
  835. 'Two cases: b/w standards and average values
  836.  
  837. End If
  838. Else:
  839.  
  840. If DF <> 0 Then
  841. If Cells(j, ColumnHI_CONC).Value / DF < High_StandardHI_CONC And Cells(j, ColumnHI_CONC).Value / DF > Low_StandardHI_CONC Then
  842.  
  843. Worksheets("Dilutions").Range(Cells(j, ColumnLO_CONC).Address).Value = -1
  844. Worksheets("Dilutions").Range(Cells(j, ColumnHI_CONC).Address).Value = 3
  845. Else:
  846. If Cells(j, ColumnLO_CONC).Value / DF < High_StandardLO_CONC And Cells(j, ColumnHI_CONC).Value / DF < Low_StandardHI_CONC Then
  847.  
  848. Worksheets("Dilutions").Range(Cells(j, ColumnLO_CONC).Address).Value = 3
  849. Worksheets("Dilutions").Range(Cells(j, ColumnHI_CONC).Address).Value = -1
  850.  
  851. Else:
  852.  
  853. If Cells(j, ColumnLO_CONC).Value / DF > High_StandardLO_CONC And Cells(j, ColumnHI_CONC).Value / DF < Low_StandardHI_CONC Then
  854.  
  855. If Low_StandardHI_CONC <= High_StandardLO_CONC Then 'Checked logic
  856.  
  857. Worksheets("Dilutions").Range(Cells(j, ColumnLO_CONC).Address).Value = 5
  858. Worksheets("Dilutions").Range(Cells(j, ColumnHI_CONC).Address).Value = 5
  859.  
  860. Else:
  861.  
  862. Worksheets("Dilutions").Range(Cells(j, ColumnLO_CONC).Address).Value = 2
  863. Worksheets("Dilutions").Range(Cells(j, ColumnHI_CONC).Address).Value = 2
  864.  
  865. End If
  866.  
  867. End If
  868.  
  869. End If
  870.  
  871. End If
  872.  
  873. End If
  874.  
  875. End If
  876.  
  877. End If
  878.  
  879.  
  880.  
  881. j = j + 1
  882.  
  883. Loop
  884.  
  885. j = FirstSampleRow
  886.  
  887.  
  888. ' Case-by-case breakdown of when to select which element for dual-wavelength element
  889. '
  890. ' **Include Val() for all numerical comparisons**
  891. '
  892. ' Case 1: Both columns maxed out: check for number listed
  893. ' Case 2: Low column maxed out, high column in-range (or slightly above range)
  894. ' Case 3: High column min'd out, low column available (possibly negative)
  895. ' Case 4: Both numbers available: pick appropriate range based on concentration
  896. ' Case 5: Low column maxed out, high column above min => either average or between standards (e.g. P)
  897. End If
  898.  
  899. End If
  900.  
  901. Else:
  902.  
  903. 'If
  904. For i = 1 To 5
  905.  
  906. If Replace(UCase(Cells(TopRow, m).Value), Space(1), Space(0)) = Replace(UCase(Extraneous(i)), Space(1), Space(0)) Then
  907.  
  908. For j = FirstSampleRow To BottomRow - 1
  909.  
  910. Worksheets("Dilutions").Range(Cells(j, m).Address).Value = -1
  911.  
  912. Next j
  913.  
  914. j = FirstSampleRow
  915.  
  916. End If
  917.  
  918. Next i
  919.  
  920. End If
  921.  
  922. m = m + 1
  923. Loop
  924.  
  925. '1)Start at TopRow + number of standards/QC on Dilutions spreadsheet
  926. '2)Go row-by-row, check if entry = 3
  927. '3)If entry = 3 subroutine: Start from top_row + standard/QC and look for same project ID, sample number, and dilution factor. If Dilution(address of entry)=1, change first cell entry from 3 to 4 and second cell from 2 to 1
  928. '
  929. '
  930. '
  931.  
  932. End If
  933.  
  934. 'Output: T=2
  935. ' 0= No dilution needed
  936. ' X1= Dilution needed; performed same day
  937. ' 2= Dilution needed; not done
  938. ' 3= Diluted sample; different analytical batch
  939. ' X4= Diluted sample; same analytical batch
  940. ' 5= Averaged samples
  941. ' -1= Non-selected wavelength
  942. 'Add-on for Copypaste function: copies and pastes dilution into appropriate cell for output= 1,4
  943.  
  944. End Function
  945.  
  946. Sub CopyPaste_DUP()
  947.  
  948. Dim DUPorig_address() As Range 'addresses of original cells for DUPs; limited to 50 due to FindQC function
  949. Dim DUP_address() As Range 'Addresses of DUPs; limited to 50 by FindQC contraint
  950. Dim DUP_List() As String 'List of Dups
  951. Dim Dilute_ListO() As String 'List of DUP original cell dilutions
  952. Dim Dilute_ListD() As String 'List of DUP dilutions
  953. Dim DUP_Project() As String 'First two letters of project for dups
  954. Dim DUP_Number() As String 'Project number of DUPs
  955. Dim TM_E() As Integer 'Indicates whether total or dissolved sample (where labelled explicitly)
  956. Dim TM_I() As Integer 'Indicates whether total or dissolved sample (where "dissolved" label implicit)
  957. Dim TopRow As Integer
  958. Dim BottomRow As Integer
  959. Dim Orig_Value As Double
  960. Dim DUP_Value As Double
  961. Dim Top_DUPs As Integer
  962. Dim Number_of_DUPS As Integer
  963. Dim Num_Standards As Integer
  964. Dim MDL_Row As Integer
  965. Dim DUP_RPD_Row As Integer
  966. Dim Brine As Integer 'Indicates whether or not brines/multiple dilutions are run of sample
  967. Dim a As Integer, a_2 As Integer, c_1 As Integer, c_2 As Integer
  968.  
  969.  
  970.  
  971. 'Top_DUPs = 0
  972. Number_of_DUPS = 0
  973. Num_Standards = 6 'Add category for this value in "Spike Values" worksheet
  974. MDL_Row = 2
  975. Brine = 0
  976.  
  977. Application.EnableEvents = False
  978.  
  979. Color_Pass = Worksheets("Spike Values").Cells(3, 1).Interior.Color ' move to top; revise for FindQC expansion
  980. Color_PassF = Worksheets("Spike Values").Cells(3, 1).Font.Color
  981. Color_Accept = Worksheets("Spike Values").Cells(4, 1).Interior.Color
  982. Color_AcceptF = Worksheets("Spike Values").Cells(4, 1).Font.Color
  983. Color_Dilute = Worksheets("Spike Values").Cells(5, 1).Interior.Color
  984. Color_DiluteF = Worksheets("Spike Values").Cells(5, 1).Font.Color
  985. Color_Fail = Worksheets("Spike Values").Cells(6, 1).Interior.Color
  986. Color_FailF = Worksheets("Spike Values").Cells(6, 1).Font.Color
  987.  
  988. ReDim DUPorig_address(1 To 50) As Range
  989. ReDim DUP_address(1 To 50) As Range
  990. ReDim DUP_List(1 To 50) As String
  991. ReDim DUP_Project(1 To 50) As String
  992. ReDim DUP_Number(1 To 50) As String
  993. ReDim Dilute_ListO(1 To 50) As String
  994. ReDim Dilute_ListD(1 To 50) As String
  995. ReDim TM_E(1 To 50) As Integer
  996. ReDim TM_I(1 To 50) As Integer
  997.  
  998.  
  999.  
  1000. TopRow = Top_Row(1)
  1001. BottomRow = Top_Row(2)
  1002.  
  1003. DUP_address = FindQC(1, 1, 0, 0)
  1004. DUP_List = FindQC(1, 5, 0, 0)
  1005. DUP_Project = FindQC(1, 3, 0, 0)
  1006. DUP_Number = FindQC(1, 4, 0, 0)
  1007. DUPorig_address = FindQC(1, 2, 0, 0)
  1008.  
  1009.  
  1010.  
  1011. 'For a = 1 To 50 'Check logic
  1012. ' If DUPorig_address(a).Address = Range("$A$1") Then
  1013. ' a_1 = a
  1014. ' For a_1 = a To 49
  1015. ' Set DUPorig_address(a_1).Address = DUPorig_address(a_1 + 1).Address
  1016. ' Set Dilute_ListO(a_1).Value = Dilute_ListO(a_1 + 1).Value
  1017. ' Next a_1
  1018. ' Set DUPorig_address(50) = Range("$A$1")
  1019. ' Set Dilute_ListO(50) = Range("$A$1")
  1020. ' End If
  1021. 'Next a
  1022.  
  1023. a_2 = 0
  1024.  
  1025. For a = 1 To 50
  1026. If DUP_address(a) <> Range("$A$1") And DUPorig_address(a) <> Range("$A$1") Then
  1027. a_2 = a_2 + 1
  1028. End If
  1029. Next a
  1030.  
  1031. For a = 1 To a_2
  1032. Dilute_ListO(a) = Dilution(1, DUPorig_address(a))
  1033. Dilute_ListD(a) = Dilution(1, DUP_address(a))
  1034. TM_E(a) = TM_Check(DUP_address(a), 1)
  1035. TM_I(a) = TM_Check(DUP_address(a), 0)
  1036. Next a
  1037.  
  1038. ReDim Preserve DUPorig_address(1 To a_2) As Range
  1039. ReDim Preserve DUP_address(1 To a_2) As Range
  1040. ReDim Preserve DUP_List(1 To a_2) As String
  1041. ReDim Preserve DUP_Project(1 To a_2) As String
  1042. ReDim Preserve DUP_Number(1 To a_2) As String
  1043. ReDim Preserve Dilute_ListO(1 To a_2) As String
  1044. ReDim Preserve Dilute_ListD(1 To a_2) As String
  1045. ReDim Preserve TM_E(1 To a_2) As Integer
  1046. ReDim Preserve TM_I(1 To a_2) As Integer
  1047.  
  1048. 'For a = 1 To a_2
  1049. ' DUPorig_address(a) = DUPorig_address1(a)
  1050. ' DUP_address(a) = DUP_address1(a)
  1051. ' DUP_List(a) = DUP_List1(a)
  1052. ' DUP_Project(a) = DUP_Project1(a)
  1053. ' DUP_Number(a) = DUP_Number1(a)
  1054. ' DUPorig_address(a) = DUPorig_address1(a)
  1055. ' Dilute_ListO(a) = Dilute_ListO1(a)
  1056. ' Dilute_ListD(a) = Dilute_ListD1(a)
  1057. ' TM_E(a) = TM_E1(a)
  1058. ' TM_I(a) = TM_I1(a)
  1059. 'Next a
  1060.  
  1061. Dilutions (2)
  1062.  
  1063. For a = 1 To a_2
  1064.  
  1065. DUP_RPD_Row = 3 + a * 4
  1066.  
  1067. If a > 2 Then
  1068.  
  1069. 'For k = 1 To Top_Row
  1070. ' If InStr(1, Cells(k + 1, 1).Value, "RELATIVE PERCENT DIFFERENCE") <> 0 Then
  1071. ' Top_DUPs = Top_DUPs + 1
  1072. ' End If
  1073. 'Next k
  1074.  
  1075. 'If Number_of_DUPS > 2 And Number_of_DUPS > Top_DUPs Then
  1076.  
  1077. Insert_Dup = (Trim(Str(DUP_RPD_Row - 2)) & ":" & Trim(Str(DUP_RPD_Row + 1))) 'FIX
  1078. Rows(Insert_Dup).Insert shift:=xlDown
  1079. Rows(Insert_Dup).Interior.ColorIndex = xlNone
  1080. Rows(Insert_Dup).Font.ColorIndex = xlblack
  1081. Rows(Insert_Dup).NumberFormat = "General"
  1082.  
  1083.  
  1084. 'For a_3 = 1 To a_2 'Not an issue with range object
  1085. ' Set DUP_address(a_3) = DUP_address(a_3).Offset(4, 0)
  1086. ' Set DUPorig_address(a_3) = Range(DUPorig_address(a_3)).Offset(4, 0)
  1087. 'Next a_3
  1088.  
  1089.  
  1090.  
  1091. Insert_Dup = (Trim(Str(DUP_RPD_Row - 2)) & ":" & Trim(Str(DUP_RPD_Row + 1)))
  1092. Worksheets("Dilutions").Rows(Insert_Dup).Insert shift:=xlDown
  1093. Worksheets("Dilutions").Rows(Insert_Dup).Interior.ColorIndex = xlNone
  1094. Worksheets("Dilutions").Rows(Insert_Dup).Font.ColorIndex = xlblack
  1095. Worksheets("Dilutions").Rows(Insert_Dup).NumberFormat = "General"
  1096.  
  1097. Rows(DUP_RPD_Row - 4).Copy
  1098. ActiveSheet.Paste Destination:=Worksheets("PSL").Rows(Str(DUP_RPD_Row))
  1099. Rows(Str(DUP_RPD_Row)).Borders(xlEdgeBottom).Weight = xlMedium
  1100. Rows(Str(DUP_RPD_Row + 2)).Borders(xlEdgeTop).Weight = xlThin
  1101. Application.CutCopyMode = False
  1102.  
  1103. TopRow = TopRow + 4
  1104. BottomRow = BottomRow + 4
  1105.  
  1106.  
  1107. End If
  1108.  
  1109. Cells(DUP_RPD_Row, 1).Value = "RELATIVE PERCENT DIFFERENCE"
  1110. Cells(DUP_RPD_Row, 1).Interior.Color = Color_Pass
  1111. Cells(DUP_RPD_Row, 1).Font.Color = Color_PassF
  1112. Cells(DUP_RPD_Row - 1, 1).Font.Bold = True
  1113. Cells(DUP_RPD_Row - 2, 1).Font.Bold = True
  1114. Cells(DUP_RPD_Row - 1, 1).Font.Italic = False
  1115. Cells(DUP_RPD_Row - 2, 1).Font.Italic = False
  1116. Rows(DUP_RPD_Row - 1).Interior.ColorIndex = xlNone
  1117. Rows(DUP_RPD_Row - 2).Interior.ColorIndex = xlNone
  1118.  
  1119. 'OrigVal = Cells(1, Range(DUPorig_address(a)).row).Value
  1120.  
  1121. If DUPorig_address(a).Value <> "" Then Cells(DUP_RPD_Row - 2, 1).Value = DUPorig_address(a).Value
  1122. If DUP_address(a).Value <> "" Then Cells(DUP_RPD_Row - 1, 1).Value = DUP_address(a).Value
  1123.  
  1124. For c_1 = 2 To 70
  1125.  
  1126.  
  1127. If Len(Cells(1, c_1).Value) > 0 Then
  1128. Cells(DUP_RPD_Row, c_1).Value = "=ABS(" & Cells(DUP_RPD_Row, c_1).Offset(-2, 0).Address(False, False) & "-" _
  1129. & Cells(DUP_RPD_Row, c_1).Offset(-1, 0).Address(False, False) & ")/AVERAGE(" & Cells(DUP_RPD_Row, c_1).Offset(-2, 0).Address(False, False) _
  1130. & "," & Cells(DUP_RPD_Row, c_1).Offset(-1, 0).Address(False, False) & ")"
  1131. If IsNumeric(Cells(DUP_RPD_Row, c_1).Value) = True Then
  1132. If Abs(Cells(DUP_RPD_Row, c_1).Value) < 1 Then Cells(DUP_RPD_Row, c_1).NumberFormat = "0.00%"
  1133. End If
  1134. End If
  1135.  
  1136.  
  1137. If Cells(1, c_1).Value <> "" Then
  1138. Cells(DUP_RPD_Row, c_1).Interior.Color = Color_Pass
  1139. Cells(DUP_RPD_Row, c_1).Font.Color = Color_PassF
  1140. End If
  1141.  
  1142. For c_2 = 2 To 70
  1143.  
  1144. 'c_2 = 13
  1145. 'c_1 = 15
  1146. 'msgbox (Replace(Cells(1, c_2).Value, Space(1), Space(0)) & "'")
  1147. 'msgbox (Replace(Left(Cells(TopRow, c_1), 2), Space(1), Space(0)) & "'")
  1148. If Replace(Cells(1, c_2).Value, Space(1), Space(0)) = Replace(Left(Cells(TopRow, c_1), 2), Space(1), Space(0)) And Replace(Cells(1, c_2).Value, Space(1), Space(0)) <> "" Then
  1149.  
  1150. 'msgbox (Worksheets("Dilutions").Cells(Range(DUPorig_address(a)).Row, c_1))
  1151.  
  1152. 'If Worksheets("Dilutions").Cells(DUPorig_address(a).Row, c_1) = -1 Then
  1153. ' Exit For
  1154. 'End If
  1155.  
  1156. If Worksheets("Dilutions").Cells(DUPorig_address(a).Row, c_1) = 0 Then
  1157.  
  1158. 'DUP_Value = Cells(i, m).Value
  1159. ''Cells(DUP_RPD_Row - 1, c_2).Value = Cells(Application.Row(DUP_address(a)), c_1).Value
  1160. Orig_Value = Cells(DUPorig_address(a).Row, c_1).Value
  1161. Cells(DUP_RPD_Row - 2, c_2).Value = Orig_Value
  1162.  
  1163. Cells(DUP_RPD_Row, c_2).Font.ColorIndex = vbBlack
  1164. Cells(DUP_RPD_Row, c_2).Interior.Color = Color_Pass
  1165. Cells(DUP_RPD_Row, c_2).Font.Color = Color_PassF
  1166.  
  1167. 'End If
  1168. 'Loop
  1169.  
  1170. End If
  1171.  
  1172. If Worksheets("Dilutions").Cells(DUPorig_address(a).Row, c_1) = 5 Then
  1173.  
  1174. If Replace(Cells(1, c_2).Value, Space(1), Space(0)) = Left(Cells(TopRow, c_1 + 1), 2) And Worksheets("Dilutions").Cells(DUPorig_address(a).Row, c_1 + 1) = 5 Then
  1175.  
  1176. 'Orig_Value = Application.Average(Cells(DUPorig_address(a).Row, c_1).Value, Cells(DUPorig_address(a).Row, c_1 + 1).Value)
  1177. Cells(DUP_RPD_Row - 2, c_2).Value = "=AVERAGE(" & Cells(DUPorig_address(a).Row, c_1).Address & ", " & Cells(DUPorig_address(a).Row, c_1 + 1).Address & ")"
  1178. Cells(DUP_RPD_Row + 1, 1).Font.Italic = True
  1179. Cells(DUP_RPD_Row + 1, 1).Value = "Note: averaged concentration values indicated by cell coloring"
  1180. Range(Cells(DUP_RPD_Row + 1, 1).Address & ":" & Cells(DUP_RPD_Row + 1, 4).Address).Interior.Color = Color_Accept
  1181. Range(Cells(DUP_RPD_Row + 1, 1).Address & ":" & Cells(DUP_RPD_Row + 1, 4).Address).Font.Color = Color_AcceptF
  1182. Cells(DUP_RPD_Row - 2, c_2).Interior.Color = Color_Accept
  1183. Cells(DUP_RPD_Row - 2, c_2).Font.Color = Color_AcceptF
  1184.  
  1185.  
  1186.  
  1187. Else:
  1188. If Replace(Cells(1, c_2).Value, Space(1), Space(0)) = Left(Cells(TopRow, c_1 - 1), 2) And Worksheets("Dilutions").Cells(DUPorig_address(a).Row, c_1 - 1) = 5 Then
  1189.  
  1190. 'Orig_Value = Application.Average(Cells(DUPorig_address(a).Row, c_1).Value, Cells(DUPorig_address(a).Row, c_1 - 1).Value)
  1191. Cells(DUP_RPD_Row - 2, c_2).Value = "=AVERAGE(" & Cells(DUPorig_address(a).Row, c_1).Address & ", " & Cells(DUPorig_address(a).Row, c_1 - 1).Address & ")"
  1192. Cells(DUP_RPD_Row + 1, 1).Font.Italic = True
  1193. Cells(DUP_RPD_Row + 1, 1).Value = "Note: averaged concentration values indicated by cell coloring"
  1194. Range(Cells(DUP_RPD_Row + 1, 1).Address & ":" & Cells(DUP_RPD_Row + 1, 4).Address).Interior.Color = Color_Accept
  1195. Range(Cells(DUP_RPD_Row + 1, 1).Address & ":" & Cells(DUP_RPD_Row + 1, 4).Address).Font.Color = Color_AcceptF
  1196. Cells(DUP_RPD_Row - 2, c_2).Interior.Color = Color_Accept
  1197. Cells(DUP_RPD_Row - 2, c_2).Font.Color = Color_AcceptF
  1198. End If
  1199. End If
  1200.  
  1201. 'DUP_Value = Cells(i, m).Value
  1202. 'Cells(DUP_RPD_Row - 1, c_2).Value = Cells(Application.Row(DUP_address(a)), c_1).Value
  1203. 'Orig_Value = Cells(j, m).Value
  1204. 'Cells(DUP_RPD_Row - 2, c_2).Value = Cells(Application.Row(DUPorig_address(a)), c_1).Value
  1205.  
  1206. 'Cells(DUP_RPD_Row, c_2).Font.ColorIndex = vbBlack
  1207. 'Cells(DUP_RPD_Row, c_2).Interior.Color = Color_Pass
  1208. 'Cells(DUP_RPD_Row, c_2).Font.Color = Color_PassF
  1209.  
  1210. 'Average two numbers, then copy/paste
  1211. ''Shade cell accordingly
  1212.  
  1213. End If
  1214.  
  1215. If Worksheets("Dilutions").Cells(DUPorig_address(a).Row, c_1) = 2 Then
  1216.  
  1217. Cells(DUP_RPD_Row, c_2).Value = "Dilute"
  1218. Union(Range(Cells(DUP_RPD_Row, c_2).Address), Range(Cells(DUP_RPD_Row - 1, c_2).Address), Range(Cells(DUP_RPD_Row - 2, c_2).Address)).Interior.Color = Color_Dilute
  1219.  
  1220. End If
  1221.  
  1222. If Worksheets("Dilutions").Cells(DUPorig_address(a).Row, c_1) = 3 Then
  1223.  
  1224. Orig_Value = Cells(DUPorig_address(a).Row, c_1).Value
  1225. Cells(DUP_RPD_Row - 2, c_2).Value = Orig_Value
  1226.  
  1227. For a_3 = 1 To a_2
  1228.  
  1229.  
  1230. If DUP_Project(a) = DUP_Project(a_3) And DUP_Number(a) = DUP_Number(a_3) And TM_E(a) = TM_E(a_3) _
  1231. And TM_I(a) = TM_I(a_3) And Worksheets("Dilutions").Cells(DUPorig_address(a_3).Row, c_1).Value = 2 _
  1232. And a > a_3 And Dilute_ListO(a_3) < Dilute_ListO(a) Then
  1233.  
  1234. For a_4 = 1 To a_2
  1235. 'Checks if additional dilutions listed
  1236. If DUP_Project(a) = DUP_Project(a_4) And DUP_Number(a) = DUP_Number(a_4) And TM_E(a) = TM_E(a_4) _
  1237. And TM_I(a) = TM_I(a_4) And Worksheets("Dilutions").Cells(DUPorig_address(a_4).Row, c_1).Value = 2 _
  1238. And a <> a_4 And a_3 <> a_4 And a <> a_3 And Dilute_ListO(a_3) <> Dilute_ListO(a) _
  1239. And Dilute_ListO(a_4) <> Dilute_ListO(a) And Dilute_ListO(a_4) <> Dilute_ListO(a_3) Then
  1240.  
  1241. Brine = 1
  1242. 'msgbox ("BRINE=1 DUP_1")
  1243. End If
  1244. Next a_4
  1245.  
  1246.  
  1247. If Brine <> 1 Then
  1248.  
  1249. DUP_RPD_Row2 = DUP_RPD_Row - Abs(4 * (a - a_3))
  1250.  
  1251. Orig_Value = Cells(DUPorig_address(a).Row, c_1).Value
  1252. Cells(DUP_RPD_Row2 - 2, c_2).Value = Orig_Value
  1253. Cells(DUP_RPD_Row2 - 2, c_2).Interior.Color = Color_Dilute
  1254. End If
  1255. End If
  1256. Next a_3
  1257.  
  1258. 'Check FindQC string for same sample ID, number, TM, but different dilution factor
  1259. 'If found, copy/paste alternate cell to destination, highlighting value in yellow
  1260. 'If not found, highlight percent in yellow, write "dilute," and put "--" in destination cell
  1261.  
  1262. End If
  1263.  
  1264. If Worksheets("Dilutions").Cells(DUP_address(a).Row, c_1) = 0 Then
  1265.  
  1266. DUP_Value = Cells(DUP_address(a).Row, c_1).Value
  1267. Cells(DUP_RPD_Row - 1, c_2).Value = DUP_Value
  1268.  
  1269. End If
  1270.  
  1271. If Worksheets("Dilutions").Cells(DUP_address(a).Row, c_1) = 5 Then
  1272.  
  1273.  
  1274. If Replace(Cells(1, c_2).Value, Space(1), Space(0)) = Left(Cells(TopRow, c_1 + 1), 2) And Worksheets("Dilutions").Cells(DUP_address(a).Row, c_1 + 1) = 5 Then
  1275.  
  1276. 'DUP_Value = Application.Average(Cells(DUP_address(a).Row, c_1).Value, Cells(DUP_address(a).Row, c_1 + 1).Value)
  1277. Cells(DUP_RPD_Row - 1, c_2).Value = "=AVERAGE(" & Cells(DUP_address(a).Row, c_1).Address & ", " & Cells(DUP_address(a).Row, c_1 + 1).Address & ")"
  1278. Cells(DUP_RPD_Row + 1, 1).Font.Italic = True
  1279. Cells(DUP_RPD_Row + 1, 1).Value = "Note: averaged concentration values indicated by cell coloring"
  1280. Range(Cells(DUP_RPD_Row + 1, 1).Address & ":" & Cells(DUP_RPD_Row + 1, 4).Address).Interior.Color = Color_Accept
  1281. Range(Cells(DUP_RPD_Row + 1, 1).Address & ":" & Cells(DUP_RPD_Row + 1, 4).Address).Font.Color = Color_AcceptF
  1282. Cells(DUP_RPD_Row - 1, c_2).Interior.Color = Color_Accept
  1283. Cells(DUP_RPD_Row - 1, c_2).Font.Color = Color_AcceptF
  1284.  
  1285. Else:
  1286. If Replace(Cells(1, c_2).Value, Space(1), Space(0)) = Left(Cells(TopRow, c_1 - 1), 2) And Worksheets("Dilutions").Cells(DUP_address(a).Row, c_1 - 1) = 5 Then
  1287.  
  1288. 'DUP_Value = Application.Average(Cells(DUP_address(a).Row, c_1).Value, Cells(DUP_address(a).Row, c_1 - 1).Value)
  1289. Cells(DUP_RPD_Row - 1, c_2).Value = "=AVERAGE(" & Cells(DUP_address(a).Row, c_1).Address & ", " & Cells(DUP_address(a).Row, c_1 - 1).Address & ")"
  1290. Cells(DUP_RPD_Row + 1, 1).Font.Italic = True
  1291. Cells(DUP_RPD_Row + 1, 1).Value = "Note: averaged concentration values indicated by cell coloring"
  1292. Range(Cells(DUP_RPD_Row + 1, 1).Address & ":" & Cells(DUP_RPD_Row + 1, 4).Address).Interior.Color = Color_Accept
  1293. Range(Cells(DUP_RPD_Row + 1, 1).Address & ":" & Cells(DUP_RPD_Row + 1, 4).Address).Font.Color = Color_AcceptF
  1294. Cells(DUP_RPD_Row - 1, c_2).Interior.Color = Color_Accept
  1295. Cells(DUP_RPD_Row - 1, c_2).Font.Color = Color_AcceptF
  1296.  
  1297. End If
  1298. End If
  1299.  
  1300. End If
  1301.  
  1302. If Worksheets("Dilutions").Cells(DUP_address(a).Row, c_1) = 3 Then
  1303.  
  1304. DUP_Value = Cells(DUP_address(a).Row, c_1).Value
  1305. Cells(DUP_RPD_Row - 1, c_2).Value = DUP_Value
  1306.  
  1307. For a_3 = 1 To a_2
  1308. If DUP_Project(a) = DUP_Project(a_3) And DUP_Number(a) = DUP_Number(a_3) And TM_E(a) = TM_E(a_3) _
  1309. And TM_I(a) = TM_I(a_3) And Worksheets("Dilutions").Cells(DUP_address(a_3).Row, c_1).Value = 2 _
  1310. And a > a_3 And Dilute_ListD(a_3) < Dilute_ListD(a) Then
  1311.  
  1312. For a_4 = 1 To a_2
  1313. 'Checks if additional dilutions listed
  1314. If DUP_Project(a) = DUP_Project(a_4) And DUP_Number(a) = DUP_Number(a_4) And TM_E(a) = TM_E(a_4) _
  1315. And TM_I(a) = TM_I(a_4) And Worksheets("Dilutions").Cells(DUP_address(a_4).Row, c_1).Value = 2 _
  1316. And a <> a_4 And a_3 <> a_4 And a <> a_3 And Dilute_ListD(a_3) <> Dilute_ListD(a) _
  1317. And Dilute_ListD(a_4) <> Dilute_ListD(a) And Dilute_ListD(a_4) <> Dilute_ListD(a_3) Then
  1318.  
  1319. Brine = 1
  1320. 'msgbox ("BRINE=1 DUP_2")
  1321. End If
  1322. Next a_4
  1323.  
  1324. If Brine <> 1 Then
  1325.  
  1326. DUP_RPD_Row2 = DUP_RPD_Row - Abs(4 * (a - a_3))
  1327.  
  1328. DUP_Value = Cells(DUP_address(a).Row, c_1).Value
  1329. Cells(DUP_RPD_Row2 - 1, c_2).Value = DUP_Value
  1330. Cells(DUP_RPD_Row2 - 1, c_2).Interior.Color = Color_Dilute
  1331. 'Worksheets("Dilutions").Cells(DUP_address(a).Row, c_2) = 1
  1332.  
  1333. If IsError(Cells(DUP_RPD_Row2, c_2)) = False Then
  1334. If IsNumeric(Cells(DUP_RPD_Row2 - 1, c_2)) = True And IsNumeric(Cells(DUP_RPD_Row2 - 2, c_2)) = True And Cells(DUP_RPD_Row2 - 1, c_2).Value <> "" And Cells(DUP_RPD_Row2 - 2, c_2).Value <> "" Then
  1335. If Len(Cells(1, c_1).Value) > 0 Then
  1336. Cells(DUP_RPD_Row2, c_2).Value = "=ABS(" & Cells(DUP_RPD_Row2, c_2).Offset(-2, 0).Address(False, False) & "-" _
  1337. & Cells(DUP_RPD_Row2, c_2).Offset(-1, 0).Address(False, False) & ")/AVERAGE(" & Cells(DUP_RPD_Row2, c_2).Offset(-2, 0).Address(False, False) _
  1338. & "," & Cells(DUP_RPD_Row2, c_2).Offset(-1, 0).Address(False, False) & ")"
  1339. If IsNumeric(Cells(DUP_RPD_Row2, c_2).Value) = True Then
  1340. If Abs(Cells(DUP_RPD_Row2, c_2).Value) < 1 Then Cells(DUP_RPD_Row2, c_2).NumberFormat = "0.00%"
  1341. End If
  1342.  
  1343. Cells(DUP_RPD_Row2, c_2).Font.ColorIndex = vbBlack
  1344. Cells(DUP_RPD_Row2, c_2).Interior.Color = Color_Pass
  1345. Cells(DUP_RPD_Row2, c_2).Font.Color = Color_PassF
  1346.  
  1347. If InStr(1, Cells(DUP_RPD_Row2, c_2).Value, "Dilute") = 0 Or IsNumeric(Cells(DUP_RPD_Row2, c_2).Offset(-1, 0).Value) = False Or IsNumeric(Cells(DUP_RPD_Row2, c_2).Offset(-2, 0).Value) = False Then
  1348.  
  1349. If Cells(MDL_Row, c_2) * 10 > Cells(DUP_RPD_Row2, c_2).Offset(-1, 0).Value / 10 And Cells(MDL_Row, c_2) * 10 > Cells(DUP_RPD_Row2, c_2).Offset(-2, 0).Value / 10 Then
  1350. 'Cells(DUP_RPD_Row2, c_2).Interior.Color = Color_Accept
  1351. 'Cells(DUP_RPD_Row2, c_2).Font.Color = Color_AcceptF
  1352. 'If Abs(Cells(DUP_RPD_Row2, c_2).Value) >= 1 Then Cells(DUP_RPD_Row2, c_2).NumberFormat = "0%"
  1353.  
  1354. Cells(DUP_RPD_Row2, c_2).Interior.Color = Color_Dilute
  1355. Cells(DUP_RPD_Row2, c_2).Font.Color = Color_DiluteF
  1356.  
  1357. Else:
  1358. If Abs(Cells(DUP_RPD_Row2, c_2).Value) >= 0.2 Then
  1359. Cells(DUP_RPD_Row2, c_2).Interior.Color = Color_Fail
  1360. Cells(DUP_RPD_Row2, c_2).Font.Color = Color_FailF
  1361. End If
  1362. End If
  1363. Else:
  1364. Cells(DUP_RPD_Row2, c_2).Interior.Color = Color_Dilute
  1365. Cells(DUP_RPD_Row2, c_2).Font.Color = Color_DiluteF
  1366. End If
  1367. End If
  1368. End If
  1369. End If
  1370. End If
  1371. End If
  1372. Next a_3
  1373. End If
  1374.  
  1375.  
  1376. If IsError(Cells(DUP_RPD_Row, c_2)) = False Then 'Delete all references to color below DUP_RPD_Row
  1377. If InStr(1, Cells(DUP_RPD_Row, c_2).Value, "Dilute") = 0 Or IsNumeric(Cells(DUP_RPD_Row, c_2).Offset(-1, 0).Value) = False Or IsNumeric(Cells(DUP_RPD_Row, c_2).Offset(-2, 0).Value) = False Then
  1378.  
  1379. If Cells(MDL_Row, c_2) * 10 > Cells(DUP_RPD_Row, c_2).Offset(-1, 0).Value And Cells(MDL_Row, c_2) * 10 > Cells(DUP_RPD_Row, c_2).Offset(-2, 0).Value Then
  1380. Cells(DUP_RPD_Row, c_2).Interior.Color = Color_Accept
  1381. Cells(DUP_RPD_Row, c_2).Font.Color = Color_AcceptF
  1382. If Abs(Cells(DUP_RPD_Row, c_2).Value) >= 1 Then Cells(DUP_RPD_Row, c_2).NumberFormat = "0%"
  1383.  
  1384. Else:
  1385. If Abs(Cells(DUP_RPD_Row, c_2).Value) >= 0.2 Then
  1386. Cells(DUP_RPD_Row, c_2).Interior.Color = Color_Fail
  1387. Cells(DUP_RPD_Row, c_2).Font.Color = Color_FailF
  1388. End If
  1389. End If
  1390. Else:
  1391. Cells(DUP_RPD_Row, c_2).Interior.Color = Color_Dilute
  1392. Cells(DUP_RPD_Row, c_2).Font.Color = Color_DiluteF
  1393. End If
  1394. End If
  1395.  
  1396. End If
  1397. Next c_2
  1398. Next c_1
  1399. Next a
  1400.  
  1401.  
  1402. 'QC function output key:
  1403. ' Info = 1 QC Sample Address(s)
  1404. ' = 2 Original Cell address(s) (DUP/LFM)
  1405. ' = 3 QC Sample Project name (DUP/LFM)
  1406. ' = 4 QC Sample Number (DUP/LFM)
  1407. ' = 5 QC Sample Project name and number (DUP/LFM)
  1408.  
  1409. 'Dilution: if Dilutions Worksheet entry = 0, 3, or 5 search & copy/paste like address from PSL worksheet into appropriate spot
  1410. '
  1411. ' Case 0: Copy/paste
  1412. ' Case 3: a. Search for neat sample within spreadsheet
  1413. ' b. For 3's, replace analyte with 2's for same element columns
  1414. ' c. Highlight data cell yellow, and change percentage cell color as necessary (must account for MDL determination for dilutions; important for brine samples)
  1415. ' c.2 Do not replace in case of brines (add option to drop-down menu for brines)
  1416. '
  1417. ' Case 5: Average, then copy/paste
  1418.  
  1419. Application.EnableEvents = True
  1420.  
  1421. End Sub
  1422.  
  1423. Function LFMSpike(LFMNumber As Integer) As Integer
  1424.  
  1425. 'Add LFM spikes used to spreadsheet
  1426.  
  1427.  
  1428. 'Worksheet change event for:
  1429. '1) Change of dropdown for LFM sample type;
  1430. '2) Change of LFM Dates setting (Cells(25+8*LFMNumber,9)
  1431. '3) Add LFB dropdown for all "LFB 1" "LFB 2" sample types, and make changeaddress accordingly
  1432. '4) Color sub to update colors
  1433.  
  1434. Dim LFMSpikeDigest() As Range
  1435. Dim LFMSpikeUndigest() As Range
  1436. Dim LFMSpikePercentD() As Range
  1437. Dim LFMSpikePercentU() As Range
  1438. Dim LFMDigestDate(1 To 3) As Double
  1439. Dim LFMUndigestDate(1 To 3) As Double
  1440. Dim LFMSpikeDRow(1 To 3) As Integer 'Row location of curent spike concentrations Digested
  1441. Dim LFMSpikeURow(1 To 3) As Integer 'Row location of curent spike concentrations Undigested/direct
  1442. Dim LFMInformationCellD As String
  1443. Dim LFMInformationCellU As String
  1444. Dim LastDUPRow As Integer
  1445. Dim j_0 As Integer
  1446.  
  1447. 'Dim ChangedLFMType as integer
  1448. 'ChangedLFMType = 0
  1449. Color_Pass = Worksheets("Spike Values").Cells(3, 1).Interior.Color
  1450. Color_PassF = Worksheets("Spike Values").Cells(3, 1).Font.Color
  1451. Color_Accept = Worksheets("Spike Values").Cells(4, 1).Interior.Color
  1452. Color_AcceptF = Worksheets("Spike Values").Cells(4, 1).Font.Color
  1453. Color_Dilute = Worksheets("Spike Values").Cells(5, 1).Interior.Color
  1454. Color_DiluteF = Worksheets("Spike Values").Cells(5, 1).Font.Color
  1455. Color_Fail = Worksheets("Spike Values").Cells(6, 1).Interior.Color
  1456. Color_FailF = Worksheets("Spike Values").Cells(6, 1).Font.Color
  1457.  
  1458.  
  1459. 'Dim SRMSpike()
  1460. 'Dim "
  1461. 'Dim "
  1462. 'Dim "
  1463.  
  1464. ReDim LFMSpikeDigest(1 To 50, 1 To 3) As Range
  1465. ReDim LFMSpikeUndigest(1 To 50, 1 To 3) As Range
  1466. ReDim LFMSpikePercentD(1 To 3) As Range
  1467. ReDim LFMSpikePercentU(1 To 3) As Range
  1468.  
  1469. For a_0 = 1 To 50
  1470. For a_1 = 1 To 3
  1471. Set LFMSpikeDigest(a_0, a_1) = Worksheets("Spike Values").Range("$A$1")
  1472. Set LFMSpikeUndigest(a_0, a_1) = Worksheets("Spike Values").Range("$A$1")
  1473. Next a_1
  1474. Next a_0
  1475.  
  1476. 'Redim LFMSpikeDigest(1 To 50) As Double 'Check length of Spike values columns, and redimension accordingly
  1477. 'ReDim LFMSpikeUndigest(1 To 50) As Double ' " " "
  1478.  
  1479. Dim CurrentDigestSpike As Range 'Address of cell listing which spike is current spike (Digested LFM Spike)
  1480. Dim CurrentUndigestSpike As Range 'Address of cell listing which spike is current spike (Undigested/direct analysis LFM Spike)
  1481. Dim LFMLetter As String * 1
  1482. Dim InputError As Integer, i_0 As Integer, msg As Integer
  1483. Dim PercentRecoveryRow As Integer
  1484.  
  1485.  
  1486. For j_0 = 1 To 100
  1487. If InStr(1, Cells(j_0, 1).Value, "RELATIVE PERCENT DIFFERENCE") <> 0 Then LastDUPRow = j_0
  1488. Next j_0
  1489.  
  1490.  
  1491. For i_0 = 1 To 3
  1492. LFMDigestDate(i_0) = 0
  1493. LFMUndigestDate(i_0) = 0
  1494. Next i_0
  1495.  
  1496.  
  1497. PercentRecoveryRow = LastDUPRow + LFMNumber * 8
  1498.  
  1499. If (InStr(1, Worksheets("Spike Values").Cells(10, 1).Value, "Digest") <> 0 And InStr(1, Worksheets("Spike Values").Cells(11, 1).Value, "Direct") <> 0) _
  1500. Or (InStr(1, Worksheets("Spike Values").Cells(10, 1).Value, "Digest") <> 0 And InStr(1, Worksheets("Spike Values").Cells(11, 1).Value, "Undig") <> 0) Then
  1501.  
  1502. Set CurrentDigestSpike = Worksheets("Spike Values").Range("$A$10:G$10")
  1503. Set CurrentUndigestSpike = Worksheets("Spike Values").Range("$A$11:$G$11")
  1504. Else:
  1505. If (InStr(1, Worksheets("Spike Values").Cells(10, 1).Value, "Direct") <> 0 And InStr(1, Worksheets("Spike Values").Cells(11, 1).Value, "Digest") <> 0) _
  1506. Or (InStr(1, Worksheets("Spike Values").Cells(10, 1).Value, "Undig") <> 0 And InStr(1, Worksheets("Spike Values").Cells(11, 1).Value, "Digest") <> 0) Then
  1507. Set CurrentUndigestSpike = Worksheets("Spike Values").Range("$A$10:$G$10")
  1508. Set CurrentDigestSpike = Worksheets("Spike Values").Range("$A$11:$G$11")
  1509. Else:
  1510.  
  1511. InputError = 0
  1512.  
  1513. For i_0 = 12 To 21
  1514. If InStr(1, Worksheets("Spike Values").Cells(i_0, 1), "Direct") <> 0 Then
  1515. Set CurrentUndigestSpike = Worksheets("Spike Values").Range(Cells(i_0, 1).Address & ":" & Cells(i_0, 7).Address)
  1516. InputError = 1 + InputError
  1517. End If
  1518.  
  1519. If InStr(1, Worksheets("Spike Values").Cells(i_0, 1), "Digest") <> 0 Or InStr(1, Worksheets("Spike Values").Cells(i_0, 1), "Undig") <> 0 Then
  1520. Set CurrentDigestSpike = Worksheets("Spike Values").Range(Cells(i_0, 1).Address & ":" & Cells(i_0, 7).Address)
  1521. InputError = 1 + InputError
  1522. End If
  1523.  
  1524. Next i_0
  1525.  
  1526. If InputError < 2 Then
  1527. msg = msgbox("Please input current LFM spikes used in 'Spike Values' sheet", vbCritical)
  1528. Exit Function
  1529. End If
  1530. End If
  1531. End If
  1532.  
  1533.  
  1534. For i_0 = 1 To 3
  1535. i_1 = 2 * i_0 + 1
  1536.  
  1537. 'Worksheets("Spike Values").Cells(CurrentDigestSpike.Row, i_1).NumberFormat = "General"
  1538. If Worksheets("Spike Values").Cells(CurrentDigestSpike.Row, i_1).Value <> 0 Then
  1539. LFMDigestDate(i_0) = DateValue(Worksheets("Spike Values").Cells(CurrentDigestSpike.Row, i_1).Value)
  1540. Else:
  1541. LFMDigestDate(i_0) = 0
  1542. End If
  1543. 'Worksheets("Spike Values").Cells(CurrentDigestSpike.Row, i_1).NumberFormat = "mm/dd/yy;@"
  1544.  
  1545. 'Worksheets("Spike Values").Cells(CurrentUndigestSpike.Row, i_1).NumberFormat = "General"
  1546. If Worksheets("Spike Values").Cells(CurrentUndigestSpike.Row, i_1).Value <> 0 Then
  1547. LFMUndigestDate(i_0) = DateValue(Worksheets("Spike Values").Cells(CurrentUndigestSpike.Row, i_1).Value)
  1548. Else:
  1549. LFMUndigestDate(i_0) = 0
  1550. End If
  1551. 'Worksheets("Spike Values").Cells(CurrentUndigestSpike.Row, i_1).NumberFormat = "mm/dd/yy;@"
  1552.  
  1553. Next i_0
  1554.  
  1555. For i_0 = 1 To 3
  1556. i_2 = 23 'Start of LFM et al spike concentrations
  1557. i_1 = i_0 * 2 + 1
  1558.  
  1559. If i_0 = 1 Then LFMLetter = "A"
  1560. If i_0 = 2 Then LFMLetter = "B"
  1561. If i_0 = 3 Then LFMLetter = "C"
  1562.  
  1563.  
  1564. Do Until Worksheets("Spike Values").Cells(i_2, 1).Value = ""
  1565. 'Worksheets("Spike Values").Cells(i_2, 3).NumberFormat = "General"
  1566. If InStr(1, Worksheets("Spike Values").Cells(i_2, 1).Value, LFMLetter) <> 0 Then
  1567. If Worksheets("Spike Values").Cells(i_2, 3).Value <> "" Then
  1568. If DateValue(Worksheets("Spike Values").Cells(i_2, 3).Value) = LFMDigestDate(i_0) Then
  1569. LFMSpikeDRow(i_0) = i_2
  1570. Set LFMSpikePercentD(i_0) = Range(Worksheets("Spike Values").Cells(i_2, 2).Address)
  1571. End If
  1572. End If
  1573. End If
  1574.  
  1575. If InStr(1, Worksheets("Spike Values").Cells(i_2, 1).Value, LFMLetter) <> 0 Then
  1576. If Worksheets("Spike Values").Cells(i_2, 3).Value <> "" Then
  1577. If DateValue(Worksheets("Spike Values").Cells(i_2, 3).Value) = LFMUndigestDate(i_0) Then
  1578. LFMSpikeURow(i_0) = i_2
  1579. Set LFMSpikePercentU(i_0) = Range(Worksheets("Spike Values").Cells(i_2, 2).Address)
  1580. End If
  1581. End If
  1582. End If
  1583.  
  1584. 'Worksheets("Spike Values").Cells(i_2, 3).NumberFormat = "mm/dd/yy;@"
  1585. i_2 = i_2 + 1
  1586. Loop
  1587.  
  1588. Next i_0
  1589.  
  1590. For a_0 = 1 To 50
  1591. a_1 = a_0 + 3 '3=Start column of element spike listing
  1592. Set LFMSpikeDigest(a_0, 1) = Range(Worksheets("Spike Values").Cells(LFMSpikeDRow(1), a_1).Address)
  1593.  
  1594. If LFMSpikeDRow(2) <> 0 Then
  1595. Set LFMSpikeDigest(a_0, 2) = Range(Worksheets("Spike Values").Cells(LFMSpikeDRow(2), a_1).Address)
  1596. Else:
  1597. Set LFMSpikeDigest(a_0, 2) = Range("$A$1")
  1598. End If
  1599.  
  1600. If LFMSpikeDRow(3) = 0 Then
  1601. Set LFMSpikeDigest(a_0, 3) = Range("$A$1")
  1602. Else:
  1603. Set LFMSpikeDigest(a_0, 3) = Range(Worksheets("Spike Values").Cells(LFMSpikeDRow(3), a_1).Address)
  1604. End If
  1605.  
  1606. Set LFMSpikeUndigest(a_0, 1) = Range(Worksheets("Spike Values").Cells(LFMSpikeURow(1), a_1).Address)
  1607.  
  1608. If LFMSpikeURow(2) <> 0 Then
  1609. Set LFMSpikeUndigest(a_0, 2) = Range(Worksheets("Spike Values").Cells(LFMSpikeURow(2), a_1).Address)
  1610. Else:
  1611. Set LFMSpikeUndigest(a_0, 2) = Range("$A$1")
  1612. End If
  1613.  
  1614. If LFMSpikeURow(3) = 0 Then
  1615. Set LFMSpikeUndigest(a_0, 3) = Range("$A$1")
  1616. Else:
  1617. Set LFMSpikeUndigest(a_0, 3) = Range(Worksheets("Spike Values").Cells(LFMSpikeURow(3), a_1).Address)
  1618. End If
  1619. Next a_0
  1620.  
  1621.  
  1622.  
  1623.  
  1624.  
  1625. If Cells(PercentRecoveryRow - 6, 1).Value = "" Then
  1626.  
  1627. 'Insert Brine, Soil cases
  1628.  
  1629. If InStr(1, UCase(Cells(PercentRecoveryRow - 5, 1).Value), "TO") <> 0 Or InStr(1, UCase(Cells(PercentRecoveryRow - 5, 1).Value), "PS") <> 0 Or InStr(1, UCase(Cells(PercentRecoveryRow - 5, 1).Value), "CA") <> 0 Or InStr(1, UCase(Cells(PercentRecoveryRow - 5, 1).Value), "VI") <> 0 Or InStr(1, UCase(Cells(PercentRecoveryRow - 5, 1).Value), "IL") <> 0 Or InStr(1, UCase(Cells(PercentRecoveryRow - 5, 1).Value), "NP") <> 0 Then
  1630. ChangedLFMType = 1
  1631. Cells(PercentRecoveryRow - 6, 1).Value = "DIGESTED SAMPLES (e.g. TOLLWAY)"
  1632. Cells(PercentRecoveryRow - 6, 1).Interior.Color = Color_Dilute
  1633. Else:
  1634. If InStr(1, UCase(Cells(PercentRecoveryRow - 5, 1).Value), "MG") <> 0 Then
  1635. Cells(PercentRecoveryRow - 6, 1).Value = "DIRECT ANALYSIS HIGH VOLUME (e.g. PS Cu)"
  1636. Cells(PercentRecoveryRow - 6, 1).Interior.Color = Color_Dilute
  1637. Cells(PercentRecoveryRow - 6, 2).Interior.Color = Color_Dilute
  1638. Else:
  1639. If InStr(1, UCase(Cells(PercentRecoveryRow - 5, 1).Value), "OO") <> 0 Then
  1640. Cells(PercentRecoveryRow - 6, 1).Value = "DIRECT ANALYSIS LOW VOLUME"
  1641. Cells(PercentRecoveryRow - 6, 1).Interior.Color = Color_Dilute
  1642. End If
  1643. End If
  1644. End If
  1645. End If
  1646.  
  1647.  
  1648. 'Match LFM Spike first
  1649.  
  1650.  
  1651. If InStr(1, Cells(PercentRecoveryRow - 6, 1).Value, "DIGESTED") <> 0 Then
  1652.  
  1653. For a_0 = 2 To 50 'PSL Worksheet Top row element listing
  1654.  
  1655. If Cells(1, a_0).Value = "" Then
  1656. Exit For
  1657. End If
  1658. For a_1 = 1 To 50 'Spike Values Worksheet element listing
  1659. If InStr(Worksheets("Spike Values").Cells(22, LFMSpikeDigest(a_1, 1).Column).Value, Replace(Cells(1, a_0).Value, Space(1), Space(0))) <> 0 Then
  1660. If LFMSpikeDigest(a_1, 2).Address <> Range("$A$1").Address Then
  1661. If LFMSpikeDigest(a_1, 3).Address <> Range("$A$1").Address Then
  1662. Cells(PercentRecoveryRow - 1, a_0).Value = "='Spike Values'!" & LFMSpikeDigest(a_1, 1).Address & "+'Spike Values'!" & LFMSpikeDigest(a_1, 2).Address & "+'Spike Values'!" & LFMSpikeDigest(a_1, 3).Address
  1663. Exit For
  1664. Else:
  1665. Cells(PercentRecoveryRow - 1, a_0).Value = "='Spike Values'!" & LFMSpikeDigest(a_1, 1).Address & "+'Spike Values'!" & LFMSpikeDigest(a_1, 2).Address
  1666. Exit For
  1667. End If
  1668. Else:
  1669. Cells(PercentRecoveryRow - 1, a_0).Value = "='Spike Values'!" & LFMSpikeDigest(a_1, 1).Address
  1670. Exit For
  1671. End If
  1672. End If
  1673. Next a_1
  1674. Next a_0
  1675.  
  1676. Cells(PercentRecoveryRow - 6, 8).HorizontalAlignment = xlRight
  1677. Cells(PercentRecoveryRow - 6, 8).Value = "LFM Spikes ="
  1678. For i_0 = 1 To 3
  1679. If i_0 = 1 Then LFMLetter = "A"
  1680. If i_0 = 2 Then LFMLetter = "B"
  1681. If i_0 = 3 Then LFMLetter = "C"
  1682. If LFMDigestDate(i_0) <> 0 Then
  1683. 'LFMDigestDate(i_0).NumberFormat = "mm/dd/yy;@"
  1684. LFMInformationCellD = LFMInformationCellD & "Spike " & LFMLetter & ": " & Worksheets("Spike Values").Cells(LFMSpikeDRow(i_0), 3).Value & ", "
  1685. End If
  1686. Next i_0
  1687. LFMInformationCellD = Left(LFMInformationCellD, Len(LFMInformationCellD) - 2)
  1688. Cells(PercentRecoveryRow - 6, 9).Value = LFMInformationCellD
  1689.  
  1690.  
  1691.  
  1692. Else:
  1693.  
  1694. If InStr(1, Cells(PercentRecoveryRow - 6, 1).Value, "DIRECT") <> 0 Or InStr(1, Cells(PercentRecoveryRow - 6, 1).Value, "BRINE") <> 0 Then
  1695.  
  1696. For a_0 = 2 To 50
  1697.  
  1698. If Cells(1, a_0).Value = "" Then
  1699. Exit For
  1700. End If
  1701.  
  1702. For a_1 = 1 To 50
  1703. If InStr(Worksheets("Spike Values").Cells(22, LFMSpikeUndigest(a_1, 1).Column).Value, Replace(Cells(1, a_0).Value, Space(1), Space(0))) <> 0 Then
  1704. If LFMSpikeUndigest(a_1, 2).Address <> Range("$A$1").Address Then
  1705. If LFMSpikeUndigest(a_1, 3).Address <> Range("$A$1").Address Then
  1706. Cells(PercentRecoveryRow - 1, a_0).Value = "='Spike Values'!" & LFMSpikeUndigest(a_1, 1).Address & "+'Spike Values'!" & LFMSpikeUndigest(a_1, 2).Address & "+'Spike Values'!" & LFMSpikeUndigest(a_1, 3).Address
  1707. Exit For
  1708. Else:
  1709. Cells(PercentRecoveryRow - 1, a_0).Value = "='Spike Values'!" & LFMSpikeUndigest(a_1, 1).Address & "+'Spike Values'!" & LFMSpikeUndigest(a_1, 2).Address
  1710. Exit For
  1711. End If
  1712. Else:
  1713. Cells(PercentRecoveryRow - 1, a_0).Value = "='Spike Values'!" & LFMSpikeUndigest(a_1, 1).Address
  1714. Exit For
  1715. End If
  1716. End If
  1717. Next a_1
  1718. Next a_0
  1719.  
  1720.  
  1721. Cells(PercentRecoveryRow - 6, 8).HorizontalAlignment = xlRight
  1722. Cells(PercentRecoveryRow - 6, 8).Value = "LFM Spikes ="
  1723. For i_0 = 1 To 3
  1724. If i_0 = 1 Then LFMLetter = "A"
  1725. If i_0 = 2 Then LFMLetter = "B"
  1726. If i_0 = 3 Then LFMLetter = "C"
  1727. If LFMDigestDate(i_0) <> 0 Then
  1728.  
  1729. 'LFMDigestDate(i_0).NumberFormat = "mm/dd/yy;@"
  1730. LFMInformationCellU = LFMInformationCellU & "Spike " & LFMLetter & ": " & Worksheets("Spike Values").Cells(LFMSpikeURow(i_0), 3).Value & ", "
  1731. End If
  1732. Next i_0
  1733. LFMInformationCellU = Left(LFMInformationCellU, Len(LFMInformationCellU) - 2)
  1734. Cells(PercentRecoveryRow - 6, 9).Value = LFMInformationCellU
  1735.  
  1736. Else:
  1737. If InStr(1, Cells(PercentRecoveryRow - 6, 1).Value, "SOIL") <> 0 Then
  1738.  
  1739. ' SRM-value paste into PSL spreadsheet here (possibly including weights in extraneous PSL LFM row for calculation step)
  1740. '
  1741. 'For soils feature, to be added
  1742.  
  1743.  
  1744. 'Include SRM date modification where LFM date paste normally goes
  1745. '
  1746. '
  1747.  
  1748. End If
  1749. End If
  1750.  
  1751.  
  1752.  
  1753. End If
  1754.  
  1755. For a_0 = 2 To 50
  1756. If Cells(1, a_0).Value = "" Then
  1757. Exit For
  1758. End If
  1759. Cells(PercentRecoveryRow, a_0).Value = "=" & Cells(PercentRecoveryRow - 2, a_0).Address(False, False) & "/" & Cells(PercentRecoveryRow - 1, a_0).Address(False, False)
  1760. Cells(PercentRecoveryRow, a_0).NumberFormat = "0%"
  1761. Next a_0
  1762.  
  1763. If InStr(1, Cells(PercentRecoveryRow - 6, 1).Value, "DIGESTED") <> 0 Then 'Case-by-case breakdown of formulas to paste for LFM PercentRecovery row
  1764.  
  1765. For a_0 = 2 To 50
  1766. If Cells(1, a_0).Value = "" Then
  1767. Exit For
  1768. End If
  1769. Cells(PercentRecoveryRow - 2, a_0).Value = "=(" & Cells(PercentRecoveryRow - 4, a_0).Address(False, False) & "-" & Cells(PercentRecoveryRow - 5, a_0).Address(False, False) & ")"
  1770. Next a_0
  1771.  
  1772. End If
  1773.  
  1774. If InStr(1, Cells(PercentRecoveryRow - 6, 1).Value, "DIRECT ANALYSIS HIGH VOLUME") <> 0 Or InStr(Cells(PercentRecoveryRow - 6, 1).Value, "DIRECT ANALYSIS LOW VOLUME") <> 0 Or InStr(Cells(PercentRecoveryRow - 6, 1).Value, "BRINE") <> 0 Then
  1775.  
  1776. For a_0 = 2 To 50
  1777.  
  1778. If Cells(1, a_0).Value = "" Then
  1779. Exit For
  1780. End If
  1781. If LFMSpikeUndigest(1, 3) <> Range("$A$1") Then
  1782.  
  1783. Cells(PercentRecoveryRow - 2, a_0).Value = "=" & Cells(PercentRecoveryRow - 4, a_0).Address(False, False) & "-(" & Cells(PercentRecoveryRow - 5, a_0).Address(False, False) & "*(1-('Spike Values'!" & LFMSpikePercentU(1).Address & "+ 'Spike Values'!" & LFMSpikePercentU(2).Address & "+'Spike Values'!" & LFMSpikePercentU(3).Address & ")))"
  1784.  
  1785. Else:
  1786. If LFMSpikeUndigest(1, 2) <> Range("$A$1") Then
  1787.  
  1788. Cells(PercentRecoveryRow - 2, a_0).Value = "=" & Cells(PercentRecoveryRow - 4, a_0).Address(False, False) & "-(" & Cells(PercentRecoveryRow - 5, a_0).Address(False, False) & "*(1-('Spike Values'!" & LFMSpikePercentU(1).Address & "+ 'Spike Values'!" & LFMSpikePercentU(2).Address & ")))"
  1789.  
  1790. Else:
  1791. Cells(PercentRecoveryRow - 2, a_0).Value = "=" & Cells(PercentRecoveryRow - 4, a_0).Address(False, False) & "-(" & Cells(PercentRecoveryRow - 5, a_0).Address(False, False) & "*(1-'Spike Values'!" & LFMSpikePercentU(1).Address & "))"
  1792.  
  1793.  
  1794. End If
  1795. End If
  1796.  
  1797. If InStr(Cells(PercentRecoveryRow - 6, 1).Value, "BRINE") <> 0 Then
  1798. DF = Dilution(1, Range(Cells(PercentRecoveryRow - 5, 1).Address))
  1799. Cells(PercentRecoveryRow - 2, a_0).Value = Cells(PercentRecoveryRow - 2, a_0).Value & "/" & DF
  1800. Cells(PercentRecoveryRow, a_0).NumberFormat = "0%"
  1801. End If
  1802. Next a_0
  1803. End If
  1804.  
  1805. If InStr(Cells(PercentRecoveryRow - 6, 1).Value, "SOIL") <> 0 Then
  1806.  
  1807. '
  1808. '
  1809. 'For Soils feature upgrade'
  1810. '
  1811.  
  1812. End If
  1813.  
  1814. LFMSpike = ChangedLFMType
  1815.  
  1816. End Function
  1817.  
  1818. Sub CopyPaste_LFM()
  1819.  
  1820. Dim LFMorig_address() As Range 'addresses of original cells for DUPs; limited to 50 due to FindQC function
  1821. Dim LFM_address() As Range 'Addresses of DUPs; limited to 50 by FindQC contraint
  1822. Dim LFM_List() As String 'List of Dups
  1823. Dim Dilute_ListO() As String 'List of DUP original cell dilutions
  1824. Dim Dilute_ListD() As String 'List of DUP dilutions
  1825. Dim LFM_Project() As String 'First two letters of project for dups
  1826. Dim LFM_Number() As String 'Project number of DUPs
  1827. Dim TM_E() As Integer 'Indicates whether total or dissolved sample (where labelled explicitly)
  1828. Dim TM_I() As Integer 'Indicates whether total or dissolved sample (where "dissolved" label implicit)
  1829. Dim TopRow As Integer
  1830. Dim BottomRow As Integer
  1831. Dim LastDUPRow As Integer
  1832. Dim Orig_Value As Double
  1833. Dim LFM_Value As Double
  1834. Dim Top_LFMs As Integer
  1835. Dim Number_of_LFMs As Integer
  1836. Dim Num_Standards As Integer
  1837. Dim MDL_Row As Integer
  1838. Dim PercentRecoveryRow As Integer
  1839. Dim ChangedLFMType As Integer
  1840. Dim Brine As Integer 'Indicates whether or not brines/multiple dilutions are run of sample
  1841. Dim a As Integer, j_0 As Integer, a_2 As Integer, c_1 As Integer, c_2 As Integer
  1842.  
  1843. Number_of_LFMs = 0
  1844. Num_Standards = 6 'Add category for this value in "Spike Values" worksheet
  1845. MDL_Row = 2
  1846. Brine = 0
  1847.  
  1848. Application.EnableEvents = False
  1849.  
  1850. Color_Pass = Worksheets("Spike Values").Cells(3, 1).Interior.Color
  1851. Color_PassF = Worksheets("Spike Values").Cells(3, 1).Font.Color
  1852. Color_Accept = Worksheets("Spike Values").Cells(4, 1).Interior.Color
  1853. Color_AcceptF = Worksheets("Spike Values").Cells(4, 1).Font.Color
  1854. Color_Dilute = Worksheets("Spike Values").Cells(5, 1).Interior.Color
  1855. Color_DiluteF = Worksheets("Spike Values").Cells(5, 1).Font.Color
  1856. Color_Fail = Worksheets("Spike Values").Cells(6, 1).Interior.Color
  1857. Color_FailF = Worksheets("Spike Values").Cells(6, 1).Font.Color
  1858.  
  1859. ReDim LFMorig_address(1 To 50) As Range
  1860. ReDim LFM_address(1 To 50) As Range
  1861. ReDim LFM_List(1 To 50) As String
  1862. ReDim LFM_Project(1 To 50) As String
  1863. ReDim LFM_Number(1 To 50) As String
  1864. ReDim Dilute_ListO(1 To 50) As String
  1865. ReDim Dilute_ListD(1 To 50) As String
  1866. ReDim TM_E(1 To 50) As Integer
  1867. ReDim TM_I(1 To 50) As Integer
  1868.  
  1869.  
  1870.  
  1871. TopRow = Top_Row(1)
  1872. BottomRow = Top_Row(2)
  1873.  
  1874. LFM_address = FindQC(2, 1, 0, 0)
  1875. LFM_List = FindQC(2, 5, 0, 0)
  1876. LFM_Project = FindQC(2, 3, 0, 0)
  1877. LFM_Number = FindQC(2, 4, 0, 0)
  1878. LFMorig_address = FindQC(2, 2, 0, 0)
  1879.  
  1880. a_2 = 0
  1881.  
  1882.  
  1883. 'For a = 1 To 50
  1884. ' msgbox (LFM_address(a).Address)
  1885. ' msgbox (LFMorig_address(a).Address)
  1886. 'Next a
  1887.  
  1888. For a = 1 To 50
  1889. If LFM_address(a) <> Range("$A$1") And LFMorig_address(a) <> Range("$A$1") Then
  1890. a_2 = a_2 + 1
  1891. End If
  1892. Next a
  1893.  
  1894. For a = 1 To a_2
  1895. Dilute_ListO(a) = Dilution(1, LFMorig_address(a))
  1896. Dilute_ListD(a) = Dilution(1, LFM_address(a))
  1897. TM_E(a) = TM_Check(LFM_address(a), 1)
  1898. TM_I(a) = TM_Check(LFM_address(a), 0)
  1899. Next a
  1900.  
  1901. ReDim Preserve LFMorig_address(1 To a_2) As Range
  1902. ReDim Preserve LFM_address(1 To a_2) As Range
  1903. ReDim Preserve LFM_List(1 To a_2) As String
  1904. ReDim Preserve LFM_Project(1 To a_2) As String
  1905. ReDim Preserve LFM_Number(1 To a_2) As String
  1906. ReDim Preserve Dilute_ListO(1 To a_2) As String
  1907. ReDim Preserve Dilute_ListD(1 To a_2) As String
  1908. ReDim Preserve TM_E(1 To a_2) As Integer
  1909. ReDim Preserve TM_I(1 To a_2) As Integer
  1910.  
  1911.  
  1912. Dilutions (2)
  1913.  
  1914. For j_0 = 1 To 100
  1915. If InStr(1, Cells(j_0, 1).Value, "RELATIVE PERCENT DIFFERENCE") <> 0 Then LastDUPRow = j_0
  1916. Next j_0
  1917.  
  1918. For a = 1 To a_2
  1919.  
  1920. PercentRecoveryRow = LastDUPRow + a * 8
  1921.  
  1922. If a > 2 Then
  1923.  
  1924.  
  1925. Insert_LFM = (Trim(Str(PercentRecoveryRow - 6)) & ":" & Trim(Str(PercentRecoveryRow + 1)))
  1926. Rows(Insert_LFM).Insert shift:=xlDown
  1927. Rows(Insert_LFM).Interior.ColorIndex = xlNone
  1928. Rows(Insert_LFM).Font.ColorIndex = xlblack
  1929. Rows(Insert_LFM).NumberFormat = "General"
  1930.  
  1931. Insert_LFM = (Trim(Str(PercentRecoveryRow - 6)) & ":" & Trim(Str(PercentRecoveryRow + 1)))
  1932. Worksheets("Dilutions").Rows(Insert_LFM).Insert shift:=xlDown
  1933. Worksheets("Dilutions").Rows(Insert_LFM).Interior.ColorIndex = xlNone
  1934. Worksheets("Dilutions").Rows(Insert_LFM).Font.ColorIndex = xlblack
  1935. Worksheets("Dilutions").Rows(Insert_LFM).NumberFormat = "General"
  1936.  
  1937.  
  1938.  
  1939.  
  1940. Worksheets("Reset").Rows(17).Copy
  1941. ActiveSheet.Paste Destination:=Worksheets("PSL").Rows(Str(PercentRecoveryRow - 2))
  1942. ' Cells(PercentRecoveryRow - 9, 1).Copy
  1943. Worksheets("Reset").Rows(18).Copy
  1944. ActiveSheet.Paste Destination:=Worksheets("PSL").Rows(Str(PercentRecoveryRow - 1))
  1945. ' Cells(PercentRecoveryRow - 8, 1).Copy
  1946. Worksheets("Reset").Rows(19).Copy
  1947. ActiveSheet.Paste Destination:=Worksheets("PSL").Rows(Str(PercentRecoveryRow))
  1948.  
  1949. Rows(Str(PercentRecoveryRow)).Borders(xlEdgeBottom).Weight = xlMedium
  1950. Rows(Str(PercentRecoveryRow + 2)).Borders(xlEdgeTop).Weight = xlThin
  1951. Application.CutCopyMode = False
  1952.  
  1953. Worksheets("Reset").Rows(13).Copy
  1954. ActiveSheet.Paste Destination:=Worksheets("PSL").Rows(Str(PercentRecoveryRow - 6))
  1955.  
  1956.  
  1957. TopRow = TopRow + 8
  1958. BottomRow = BottomRow + 8
  1959.  
  1960. End If
  1961.  
  1962. If LFMorig_address(a).Value <> "" Then Cells(PercentRecoveryRow - 5, 1).Value = LFMorig_address(a).Value
  1963. If LFM_address(a).Value <> "" Then Cells(PercentRecoveryRow - 4, 1).Value = LFM_address(a).Value
  1964.  
  1965. ChangedLFMType = LFMSpike(a)
  1966.  
  1967. Cells(PercentRecoveryRow, 1).Value = "PERCENT RECOVERY"
  1968. Cells(PercentRecoveryRow, 1).Interior.Color = Color_Pass
  1969. Cells(PercentRecoveryRow, 1).Font.Color = Color_PassF
  1970. Rows(PercentRecoveryRow - 1).Interior.ColorIndex = xlNone
  1971. Rows(PercentRecoveryRow - 2).Interior.ColorIndex = xlNone
  1972. Cells(PercentRecoveryRow - 4, 1).Font.Bold = True
  1973. Cells(PercentRecoveryRow - 4, 1).Font.Italic = False
  1974. Cells(PercentRecoveryRow - 5, 1).Font.Bold = True
  1975. Cells(PercentRecoveryRow - 5, 1).Font.Italic = False
  1976. Cells(PercentRecoveryRow - 4, 1).Interior.ColorIndex = xlNone
  1977. Cells(PercentRecoveryRow - 5, 1).Interior.ColorIndex = xlNone
  1978.  
  1979. 'OrigVal = Cells(1, Range(LFMorig_address(a)).row).Value
  1980.  
  1981. For c_1 = 2 To 100
  1982.  
  1983. For c_2 = 2 To 70
  1984.  
  1985. 'c_2 = 13
  1986. 'c_1 = 15
  1987. 'msgbox (Replace(Cells(1, c_2).Value, Space(1), Space(0)) & "'")
  1988. 'msgbox (Replace(Left(Cells(TopRow, c_1), 2), Space(1), Space(0)) & "'")
  1989. If Replace(Cells(1, c_2).Value, Space(1), Space(0)) = Replace(Left(Cells(TopRow, c_1), 2), Space(1), Space(0)) And Replace(Cells(1, c_2).Value, Space(1), Space(0)) <> "" Then
  1990.  
  1991. Cells(PercentRecoveryRow, c_2).Interior.Color = Color_Pass
  1992. Cells(PercentRecoveryRow, c_2).Font.Color = Color_PassF
  1993.  
  1994. If Worksheets("Dilutions").Cells(LFMorig_address(a).Row, c_1) = 0 Then
  1995.  
  1996. 'LFM_Value = Cells(i, m).Value
  1997. ''Cells(PercentRecoveryRow - 1, c_2).Value = Cells(Application.Row(LFM_address(a)), c_1).Value
  1998. Orig_Value = Cells(LFMorig_address(a).Row, c_1).Value
  1999. Cells(PercentRecoveryRow - 5, c_2).Value = Orig_Value
  2000.  
  2001. Cells(PercentRecoveryRow, c_2).Font.ColorIndex = vbBlack
  2002. Cells(PercentRecoveryRow, c_2).Interior.Color = Color_Pass
  2003. Cells(PercentRecoveryRow, c_2).Font.Color = Color_PassF
  2004.  
  2005. 'End If
  2006. 'Loop
  2007.  
  2008. End If
  2009.  
  2010. If Worksheets("Dilutions").Cells(LFMorig_address(a).Row, c_1) = 5 Then
  2011.  
  2012. If Replace(Cells(1, c_2).Value, Space(1), Space(0)) = Left(Cells(TopRow, c_1 + 1), 2) And Worksheets("Dilutions").Cells(LFMorig_address(a).Row, c_1 + 1) = 5 Then
  2013.  
  2014. 'Orig_Value = Application.Average(Cells(LFMorig_address(a).Row, c_1).Value, Cells(LFMorig_address(a).Row, c_1 + 1).Value)
  2015. Cells(PercentRecoveryRow - 5, c_2).Value = "=AVERAGE(" & Cells(LFMorig_address(a).Row, c_1).Address & ", " & Cells(LFMorig_address(a).Row, c_1 + 1).Address & ")"
  2016. Cells(PercentRecoveryRow + 1, 1).Font.Italic = True
  2017. Cells(PercentRecoveryRow + 1, 1).Value = "Note: averaged concentration values indicated by cell coloring"
  2018. Range(Cells(PercentRecoveryRow + 1, 1).Address & ":" & Cells(PercentRecoveryRow + 1, 4).Address).Interior.Color = Color_Accept
  2019. Range(Cells(PercentRecoveryRow + 1, 1).Address & ":" & Cells(PercentRecoveryRow + 1, 4).Address).Font.Color = Color_AcceptF
  2020. Cells(PercentRecoveryRow - 5, c_2).Interior.Color = Color_Accept
  2021. Cells(PercentRecoveryRow - 5, c_2).Font.Color = Color_AcceptF
  2022.  
  2023. Else:
  2024. If Replace(Cells(1, c_2).Value, Space(1), Space(0)) = Left(Cells(TopRow, c_1 - 1), 2) And Worksheets("Dilutions").Cells(LFMorig_address(a).Row, c_1 - 1) = 5 Then
  2025.  
  2026. 'Orig_Value = Application.Average(Cells(LFMorig_address(a).Row, c_1).Value, Cells(LFMorig_address(a).Row, c_1 - 1).Value)
  2027. Cells(PercentRecoveryRow - 5, c_2).Value = "=AVERAGE(" & Cells(LFMorig_address(a).Row, c_1).Address & ", " & Cells(LFMorig_address(a).Row, c_1 - 1).Address & ")"
  2028. Cells(PercentRecoveryRow + 1, 1).Font.Italic = True
  2029. Cells(PercentRecoveryRow + 1, 1).Value = "Note: averaged concentration values indicated by cell coloring"
  2030. Range(Cells(PercentRecoveryRow + 1, 1).Address & ":" & Cells(PercentRecoveryRow + 1, 4).Address).Interior.Color = Color_Accept
  2031. Range(Cells(PercentRecoveryRow + 1, 1).Address & ":" & Cells(PercentRecoveryRow + 1, 4).Address).Font.Color = Color_AcceptF
  2032. Cells(PercentRecoveryRow - 5, c_2).Interior.Color = Color_Accept
  2033. Cells(PercentRecoveryRow - 5, c_2).Font.Color = Color_AcceptF
  2034.  
  2035.  
  2036.  
  2037.  
  2038. End If
  2039. End If
  2040.  
  2041. 'LFM_Value = Cells(i, m).Value
  2042. 'Cells(PercentRecoveryRow - 1, c_2).Value = Cells(Application.Row(LFM_address(a)), c_1).Value
  2043. 'Orig_Value = Cells(j, m).Value
  2044. 'Cells(PercentRecoveryRow - 2, c_2).Value = Cells(Application.Row(LFMorig_address(a)), c_1).Value
  2045.  
  2046. 'Cells(PercentRecoveryRow, c_2).Font.ColorIndex = vbBlack
  2047. 'Cells(PercentRecoveryRow, c_2).Interior.Color = Color_Pass
  2048. 'Cells(PercentRecoveryRow, c_2).Font.Color = Color_PassF
  2049.  
  2050. 'Average two numbers, then copy/paste
  2051. ''Shade cell accordingly
  2052.  
  2053. End If
  2054.  
  2055. If Worksheets("Dilutions").Cells(LFMorig_address(a).Row, c_1) = 2 Or Worksheets("Dilutions").Cells(LFM_address(a).Row, c_1) = 2 Then
  2056.  
  2057. Cells(PercentRecoveryRow, c_2).Value = "Dilute"
  2058. Union(Range(Cells(PercentRecoveryRow, c_2).Address), Range(Cells(PercentRecoveryRow - 4, c_2).Address), Range(Cells(PercentRecoveryRow - 5, c_2).Address)).Interior.Color = Color_Dilute
  2059.  
  2060. End If
  2061.  
  2062. If Worksheets("Dilutions").Cells(LFMorig_address(a).Row, c_1) = 3 Then
  2063.  
  2064. Orig_Value = Cells(LFMorig_address(a).Row, c_1).Value
  2065. Cells(PercentRecoveryRow - 5, c_2).Value = Orig_Value
  2066.  
  2067. For a_3 = 1 To a_2
  2068.  
  2069. If LFM_Project(a) = LFM_Project(a_3) And LFM_Number(a) = LFM_Number(a_3) And TM_E(a) = TM_E(a_3) _
  2070. And TM_I(a) = TM_I(a_3) And Worksheets("Dilutions").Cells(LFMorig_address(a_3).Row, c_1).Value = 2 _
  2071. And a > a_3 And Dilute_ListO(a_3) < Dilute_ListO(a) Then
  2072.  
  2073. For a_4 = 1 To a_2
  2074. 'Checks if additional dilutions listed
  2075. If LFM_Project(a) = LFM_Project(a_4) And LFM_Number(a) = LFM_Number(a_4) And TM_E(a) = TM_E(a_4) _
  2076. And TM_I(a) = TM_I(a_4) And Worksheets("Dilutions").Cells(LFMorig_address(a_4).Row, c_1).Value = 2 _
  2077. And a <> a_4 And a_3 <> a_4 And a <> a_3 And Dilute_ListO(a_3) <> Dilute_ListO(a) _
  2078. And Dilute_ListO(a_4) <> Dilute_ListO(a) And Dilute_ListO(a_4) <> Dilute_ListO(a_3) Then
  2079.  
  2080. Brine = 1
  2081. 'msgbox ("BRINE=1 LFM_1")
  2082. End If
  2083. Next a_4
  2084.  
  2085.  
  2086. If Brine <> 1 Then
  2087.  
  2088.  
  2089. For a_5 = 1 To TopRow
  2090.  
  2091. If InStr(1, Replace(LFM_List(a), Space(1), Space(0)), Replace(Cells(a_5, 1).Value, Space(1), Space(0))) <> 0 Then
  2092. If Dilution(1, Range(Cells(a_5, 1).Address)) > Dilution(1, Range(Cells(a, 1).Address)) Then
  2093. PercentRecoveryRow2 = a_5 + 4
  2094. End If
  2095. End If
  2096.  
  2097. Next a_5
  2098.  
  2099. 'PercentRecoveryRow2 = PercentRecoveryRow - Abs(8 * (a - a_3))
  2100.  
  2101. Orig_Value = Cells(LFMorig_address(a).Row, c_1).Value
  2102. Cells(PercentRecoveryRow2 - 5, c_2).Value = Orig_Value
  2103. Cells(PercentRecoveryRow2 - 5, c_2).Interior.Color = Color_Dilute
  2104. End If
  2105. End If
  2106. Next a_3
  2107.  
  2108. 'Check FindQC string for same sample ID, number, TM, but different dilution factor
  2109. 'If found, copy/paste alternate cell to destination, highlighting value in yellow
  2110. 'If not found, highlight percent in yellow, write "dilute," and put "--" in destination cell
  2111.  
  2112. End If
  2113.  
  2114. If Worksheets("Dilutions").Cells(LFM_address(a).Row, c_1) = 0 Then
  2115.  
  2116. LFM_Value = Cells(LFM_address(a).Row, c_1).Value
  2117. Cells(PercentRecoveryRow - 4, c_2).Value = LFM_Value
  2118.  
  2119. End If
  2120.  
  2121. If Worksheets("Dilutions").Cells(LFM_address(a).Row, c_1) = 5 Then
  2122.  
  2123. If Replace(Cells(1, c_2).Value, Space(1), Space(0)) = Left(Cells(TopRow, c_1 + 1), 2) And Worksheets("Dilutions").Cells(LFM_address(a).Row, c_1 + 1) = 5 Then
  2124.  
  2125. 'LFM_Value = Application.Average(Cells(LFM_address(a).Row, c_1).Value, Cells(LFM_address(a).Row, c_1 + 1).Value)
  2126. Cells(PercentRecoveryRow - 4, c_2).Value = "=AVERAGE(" & Cells(LFM_address(a).Row, c_1).Address & ", " & Cells(LFM_address(a).Row, c_1 + 1).Address & ")"
  2127. Cells(PercentRecoveryRow + 1, 1).Font.Italic = True
  2128. Cells(PercentRecoveryRow + 1, 1).Value = "Note: averaged concentration values indicated by cell coloring"
  2129. Range(Cells(PercentRecoveryRow + 1, 1).Address & ":" & Cells(PercentRecoveryRow + 1, 4).Address).Interior.Color = Color_Accept
  2130. Range(Cells(PercentRecoveryRow + 1, 1).Address & ":" & Cells(PercentRecoveryRow + 1, 4).Address).Font.Color = Color_AcceptF
  2131. Cells(PercentRecoveryRow - 4, c_2).Interior.Color = Color_Accept
  2132. Cells(PercentRecoveryRow - 4, c_2).Font.Color = Color_AcceptF
  2133.  
  2134. Else:
  2135. If Replace(Cells(1, c_2).Value, Space(1), Space(0)) = Left(Cells(TopRow, c_1 - 1), 2) And Worksheets("Dilutions").Cells(LFM_address(a).Row, c_1 - 1) = 5 Then
  2136.  
  2137. 'LFM_Value = Application.Average(Cells(LFM_address(a).Row, c_1).Value, Cells(LFM_address(a).Row, c_1 - 1).Value)
  2138. Cells(PercentRecoveryRow - 4, c_2).Value = "=AVERAGE(" & Cells(LFM_address(a).Row, c_1).Address & ", " & Cells(LFM_address(a).Row, c_1 - 1).Address & ")"
  2139. Cells(PercentRecoveryRow + 1, 1).Font.Italic = True
  2140. Cells(PercentRecoveryRow + 1, 1).Value = "Note: averaged concentration values indicated by cell coloring"
  2141. Range(Cells(PercentRecoveryRow + 1, 1).Address & ":" & Cells(PercentRecoveryRow + 1, 4).Address).Interior.Color = Color_Accept
  2142. Range(Cells(PercentRecoveryRow + 1, 1).Address & ":" & Cells(PercentRecoveryRow + 1, 4).Address).Font.Color = Color_AcceptF
  2143. Cells(PercentRecoveryRow - 4, c_2).Interior.Color = Color_Accept
  2144. Cells(PercentRecoveryRow - 4, c_2).Font.Color = Color_AcceptF
  2145.  
  2146.  
  2147. End If
  2148. End If
  2149.  
  2150. End If
  2151.  
  2152. If Worksheets("Dilutions").Cells(LFM_address(a).Row, c_1) = 3 Then
  2153.  
  2154. LFM_Value = Cells(LFM_address(a).Row, c_1).Value
  2155. Cells(PercentRecoveryRow - 4, c_2).Value = LFM_Value
  2156.  
  2157. For a_3 = 1 To a_2
  2158. If LFM_Project(a) = LFM_Project(a_3) And LFM_Number(a) = LFM_Number(a_3) And TM_E(a) = TM_E(a_3) _
  2159. And TM_I(a) = TM_I(a_3) And Worksheets("Dilutions").Cells(LFM_address(a_3).Row, c_1).Value = 2 _
  2160. And a > a_3 And Dilute_ListD(a_3) < Dilute_ListD(a) Then
  2161.  
  2162. For a_4 = 1 To a_2
  2163. 'Checks if additional dilutions listed
  2164. If LFM_Project(a) = LFM_Project(a_4) And LFM_Number(a) = LFM_Number(a_4) And TM_E(a) = TM_E(a_4) _
  2165. And TM_I(a) = TM_I(a_4) And Worksheets("Dilutions").Cells(LFM_address(a_4).Row, c_1).Value = 2 _
  2166. And a <> a_4 And a_3 <> a_4 And a <> a_3 And Dilute_ListD(a_3) <> Dilute_ListD(a) _
  2167. And Dilute_ListD(a_4) <> Dilute_ListD(a) And Dilute_ListD(a_4) <> Dilute_ListD(a_3) Then
  2168.  
  2169. Brine = 1
  2170. 'msgbox ("BRINE=1 LFM_2")
  2171. End If
  2172. Next a_4
  2173.  
  2174. If Brine <> 1 Then
  2175.  
  2176. 'PercentRecoveryRow2 = PercentRecoveryRow - Abs(4 * (a - a_3))
  2177.  
  2178. For a_5 = 1 To TopRow
  2179.  
  2180.  
  2181. If InStr(1, Replace(LFM_List(a), Space(1), Space(0)), Replace(Cells(a_5, 1).Value, Space(1), Space(0))) <> 0 Then
  2182. If Dilution(1, Range(Cells(a_5, 1).Address)) > Dilution(1, Range(Cells(a, 1).Address)) Then
  2183. PercentRecoveryRow2 = a_5 + 4
  2184. End If
  2185. End If
  2186.  
  2187. Next a_5
  2188.  
  2189. LFM_Value = Cells(LFM_address(a).Row, c_1).Value
  2190. Cells(PercentRecoveryRow2 - 4, c_2).Value = LFM_Value
  2191. Cells(PercentRecoveryRow2 - 4, c_2).Interior.Color = Color_Dilute
  2192. 'Worksheets("Dilutions").Cells(LFM_address(a).Row, c_2) = 1
  2193.  
  2194. If IsError(Cells(PercentRecoveryRow2, c_2)) = False Then
  2195. If IsNumeric(Cells(PercentRecoveryRow2 - 4, c_2)) = True And IsNumeric(Cells(PercentRecoveryRow2 - 5, c_2)) = True And Cells(PercentRecoveryRow2 - 4, c_2).Value <> "" And Cells(PercentRecoveryRow2 - 5, c_2).Value <> "" Then
  2196. If Len(Cells(1, c_1).Value) > 0 Then
  2197.  
  2198. If IsNumeric(Cells(PercentRecoveryRow2, c_2).Value) = True Then
  2199. If Abs(Cells(PercentRecoveryRow2, c_2).Value) < 1 Then Cells(PercentRecoveryRow2, c_2).NumberFormat = "0.00%"
  2200. End If
  2201.  
  2202. Cells(PercentRecoveryRow2, c_2).Font.ColorIndex = vbBlack
  2203. Cells(PercentRecoveryRow2, c_2).Interior.Color = Color_Pass
  2204. Cells(PercentRecoveryRow2, c_2).Font.Color = Color_PassF
  2205.  
  2206. If InStr(1, Cells(PercentRecoveryRow2, c_2).Value, "Dilute") = 0 Or IsNumeric(Cells(PercentRecoveryRow2, c_2).Offset(-4, 0).Value) = False Or IsNumeric(Cells(PercentRecoveryRow2, c_2).Offset(-5, 0).Value) = False Then
  2207.  
  2208.  
  2209.  
  2210. If Cells(PercentRecoveryRow2 - 1, c_2) < 0.3 * Cells(PercentRecoveryRow2 - 4, c_2) Then
  2211. Cells(PercentRecoveryRow2, c_2).Interior.Color = Color_Accept
  2212. Cells(PercentRecoveryRow2, c_2).Font.Color = Color_AcceptF
  2213.  
  2214. Else:
  2215.  
  2216. If Cells(PercentRecoveryRow2, c_2).Value <= 0.7 Or Cells(PercentRecoveryRow2, c_2).Value >= 1.3 Then
  2217. Cells(PercentRecoveryRow2, c_2).Interior.Color = Color_Fail
  2218. Cells(PercentRecoveryRow2, c_2).Font.Color = Color_FailF
  2219. End If
  2220. End If
  2221.  
  2222.  
  2223.  
  2224. Else:
  2225. Cells(PercentRecoveryRow2, c_2).Interior.Color = Color_Dilute
  2226. Cells(PercentRecoveryRow2, c_2).Font.Color = Color_DiluteF
  2227. End If
  2228. End If
  2229. End If
  2230. End If
  2231.  
  2232.  
  2233. Else:
  2234. 'Brine subroutine for LFM calculations (If not covered in LFM Spike sub; otherwise, make simplified coloring routine here (one that doesn't paste dilutions twice))
  2235. '
  2236. '
  2237. '
  2238. '
  2239. ' Entire code written by Omar Ali, 2016
  2240. ' Updated 06.20.2018
  2241. '
  2242. '
  2243.  
  2244.  
  2245. End If
  2246. End If
  2247. Next a_3
  2248. End If
  2249.  
  2250.  
  2251. If IsError(Cells(PercentRecoveryRow, c_2)) = False Then 'Delete all references to color below PercentRecoveryRow
  2252. If InStr(1, Cells(PercentRecoveryRow, c_2).Value, "Dilute") = 0 Or IsNumeric(Cells(PercentRecoveryRow, c_2).Offset(-4, 0).Value) = False Or IsNumeric(Cells(PercentRecoveryRow, c_2).Offset(-5, 0).Value) = False Then
  2253.  
  2254.  
  2255.  
  2256. If Cells(PercentRecoveryRow - 1, c_2) < 0.3 * Cells(PercentRecoveryRow - 4, c_2) Then
  2257. Cells(PercentRecoveryRow, c_2).Interior.Color = Color_Accept
  2258. Cells(PercentRecoveryRow, c_2).Font.Color = Color_AcceptF
  2259.  
  2260. Else:
  2261.  
  2262. If Cells(PercentRecoveryRow, c_2).Value <= 0.7 Or Cells(PercentRecoveryRow, c_2).Value >= 1.3 Then
  2263. Cells(PercentRecoveryRow, c_2).Interior.Color = Color_Fail
  2264. Cells(PercentRecoveryRow, c_2).Font.Color = Color_FailF
  2265. End If
  2266. End If
  2267.  
  2268.  
  2269. Else:
  2270. Cells(PercentRecoveryRow, c_2).Interior.Color = Color_Dilute
  2271. Cells(PercentRecoveryRow, c_2).Font.Color = Color_DiluteF
  2272. End If
  2273. End If
  2274. Exit For
  2275. End If
  2276. Next c_2
  2277.  
  2278. If Cells(TopRow, c_1) = "" Then
  2279. Exit For
  2280. End If
  2281. Next c_1
  2282. Next a
  2283.  
  2284.  
  2285. If ChangedLFMType = 1 Then
  2286.  
  2287. msgbox ("Please confirm sample type (digest or direct) from dropdown menu")
  2288.  
  2289. End If
  2290.  
  2291. Application.EnableEvents = True
  2292.  
  2293. End Sub
  2294.  
  2295.  
  2296. Function Y_ISTD() As Integer
  2297.  
  2298. Dim TopRow As Integer
  2299. Dim BottomRow As Integer
  2300. Dim ISTD(1 To 2) As String
  2301.  
  2302. TopRow = Top_Row(1)
  2303. BottomRow = Top_Row(2)
  2304.  
  2305. ISTD(1) = Worksheets("Spike Values").Cells(5, 3).Value
  2306. ISTD(2) = Worksheets("Spike Values").Cells(5, 4).Value
  2307.  
  2308. Color_Pass = Worksheets("Spike Values").Cells(3, 1).Interior.Color
  2309. Color_PassF = Worksheets("Spike Values").Cells(3, 1).Font.Color
  2310. Color_Accept = Worksheets("Spike Values").Cells(4, 1).Interior.Color
  2311. Color_AcceptF = Worksheets("Spike Values").Cells(4, 1).Font.Color
  2312. Color_Dilute = Worksheets("Spike Values").Cells(5, 1).Interior.Color
  2313. Color_DiluteF = Worksheets("Spike Values").Cells(5, 1).Font.Color
  2314. Color_Fail = Worksheets("Spike Values").Cells(6, 1).Interior.Color
  2315. Color_FailF = Worksheets("Spike Values").Cells(6, 1).Font.Color
  2316.  
  2317.  
  2318. For m = 1 To 100
  2319.  
  2320. If Replace(Left(Cells(TopRow, m).Value, 2), Space(1), Space(0)) = ISTD(1) Or Replace(Left(Cells(TopRow, m).Value, 2), Space(1), Space(0)) = ISTD(2) Then
  2321.  
  2322. Exit For
  2323.  
  2324. End If
  2325.  
  2326. Next m
  2327.  
  2328. If m = 101 Then
  2329. msgbox ("Error in finding internal standard")
  2330. Exit Function
  2331. End If
  2332.  
  2333. m = m + 1
  2334.  
  2335. For j = TopRow + 2 To BottomRow
  2336.  
  2337. If Cells(j, m).Value <= 0.8 Or Cells(j, m).Value >= 1.2 Then
  2338. ' If Y 371.029 > 1.2 or Y 371.029 < 0.8 then highlight in red and (if applicable) include in error/report summary
  2339. Cells(j, m).Interior.Color = Color_Fail
  2340. Cells(j, m).Font.Color = Color_FailF
  2341.  
  2342. Else:
  2343.  
  2344. Cells(j, m).Interior.Color = Color_Pass
  2345. Cells(j, m).Font.Color = Color_PassF
  2346.  
  2347. End If
  2348.  
  2349. Next j
  2350.  
  2351. End Function
  2352.  
  2353. Function Top_Row(P As Integer) As Integer
  2354.  
  2355. If P = 1 Then
  2356. 'Locate top row; end function
  2357.  
  2358. For k = 1 To 500
  2359. If InStr(1, Cells(k, 1).Value, "Sample Labels") <> 0 And InStr(1, Cells(k + 1, 1).Value, "Blank") <> 0 Then
  2360. Top_Row = k
  2361. k = 500
  2362. End If
  2363. Next k
  2364.  
  2365. k = 1
  2366.  
  2367. For k = 1 To 500
  2368. If InStr(1, Cells(k, 1).Value, "Tube") <> 0 And InStr(1, Cells(k + 1, 1).Value, ":") <> 0 Then
  2369. Top_Row = k
  2370. With Range(Cells(Top_Row, 1).Address(False, False) & ":A500")
  2371. .Delete
  2372. End With
  2373. Range(Cells(Top_Row - 1, 1).Address(False, False) & ":A500").HorizontalAlignment = xlLeft
  2374. k = 500
  2375. End If
  2376. Next k
  2377.  
  2378.  
  2379. End If
  2380. '
  2381.  
  2382. If P = 2 Then
  2383. 'Locate bottom row; end function
  2384. For k = 1 To 500
  2385. If InStr(1, Cells(k, 1).Value, "Cont Calib Blank") <> 0 And InStr(1, Cells(k + 1, 1).Value, "Cont Calib Verif LO 10%") <> 0 And InStr(1, Cells(k + 2, 1).Value, "Cont Calib Verif HI 10%") <> 0 And (Cells(k + 10, 1).Value = "" Or Cells(k + 10, 1).Value = " ") Then
  2386.  
  2387. k_1 = k
  2388.  
  2389. Do While (InStr(1, Cells(k_1, 1).Value, "Cont Calib Blank") <> 0 Or InStr(1, Cells(k_1, 1).Value, "Cont Calib Verif LO 10%") <> 0 Or InStr(1, Cells(k_1, 1).Value, "Cont Calib Verif HI 10%") <> 0 Or Cells(k_1, 1).Value = "" Or Cells(k_1, 1).Value = " ") And k_1 < 500
  2390.  
  2391. k_1 = k_1 + 1
  2392.  
  2393. Loop
  2394. If k_1 = 500 Then
  2395.  
  2396. Top_Row = k + 2
  2397. k = 500
  2398. Else
  2399. Top_Row = k_1
  2400. Exit For
  2401. End If
  2402. End If
  2403. Next k
  2404. End If
  2405.  
  2406. End Function
  2407.  
  2408. Sub Reset()
  2409.  
  2410. Application.EnableEvents = False
  2411.  
  2412. Worksheets("Reset").Range("A1:AZ500").Copy
  2413. Worksheets("PSL").Select
  2414. ActiveSheet.Paste Destination:=Worksheets("PSL").Range("A1:AZ500")
  2415. Application.CutCopyMode = False
  2416.  
  2417. Worksheets("Dilutions").UsedRange.ClearContents
  2418.  
  2419. Worksheets("Spike Values").Cells(3, 1).Interior.Color = RGB(146, 205, 220)
  2420. Worksheets("Spike Values").Cells(3, 1).Font.Color = vbBlack
  2421. Worksheets("Spike Values").Cells(4, 1).Interior.Color = RGB(217, 217, 225)
  2422. Worksheets("Spike Values").Cells(4, 1).Font.Color = vbBlack
  2423. Worksheets("Spike Values").Cells(5, 1).Interior.Color = RGB(255, 255, 150)
  2424. Worksheets("Spike Values").Cells(5, 1).Font.Color = vbBlack
  2425. Worksheets("Spike Values").Cells(6, 1).Interior.Color = RGB(255, 0, 0)
  2426. Worksheets("Spike Values").Cells(6, 1).Font.Color = vbBlack
  2427. Worksheets("Spike Values").Cells(2, 1).Font.Bold = False
  2428.  
  2429. Application.EnableEvents = True
  2430.  
  2431. End Sub
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!