Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.
Sub Analyse()
Dim WS As Worksheet
Dim MaxRow As Long
Dim cCell As Range
Dim Min As Long, Max As Long, I As Long, J As Long, K As Long
Dim factor As String
Dim Col As String
Set WS = ThisWorkbook.ActiveSheet
WS.Range("B22") = WS.Range("H33")
WS.Range("B23") = WS.Range("I33")
WS.Range("B27") = WS.Range("B33")
WS.Range("B28") = WS.Range("G33")
WS.Range("C29") = WS.Range("A33")
'---> High
If WS.Range("C29") = "High" Then
WS.Range("B49") = WS.Range("B49") + 1
WS.Range("D49") = WS.Range("D49") + 1
WS.Range("F49") = WS.Range("F49") + 1
WS.Range("H49") = WS.Range("H49") + 1
'---> Step 02,03,04,05
For K = 1 To 2
For I = 22 To 23
If K = 1 And I = 22 Then
Col = "C"
fcol = "B"
ElseIf K = 1 And I = 23 Then
Col = "C"
fcol = "D"
ElseIf K = 2 And I = 22 Then
Col = "G"
fcol = "F"
ElseIf K = 2 And I = 23 Then
Col = "G"
fcol = "H"
End If
Min = WS.Range("C" & I) - 4
Max = WS.Range("C" & I) + 4
For J = 2 To 11
If WS.Range(Col & J) >= Min And WS.Range(Col & J) <= Max Then
factor = WS.Range(Col & J).Offset(0, -2)
If factor = "Close Hits" Or factor = "Point Hits" Then factor = "Unity"
Exit For
End If
Next J
If factor <> "" Then
Set cCell = WS.Range("A39:A48").Find(what:=factor, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not cCell Is Nothing Then
WS.Cells(cCell.Row, fcol) = WS.Cells(cCell.Row, fcol) + 1
End If
factor = ""
End If
Next I
Next K
End If
'---> Low
If WS.Range("C29") = "Low" Then
WS.Range("B60") = WS.Range("B60") + 1
WS.Range("D60") = WS.Range("D60") + 1
WS.Range("F60") = WS.Range("F60") + 1
WS.Range("H60") = WS.Range("H60") + 1
'---> Step 02,03,04,05
For K = 1 To 2
For I = 22 To 23
If K = 1 And I = 22 Then
Col = "C"
fcol = "B"
ElseIf K = 1 And I = 23 Then
Col = "C"
fcol = "D"
ElseIf K = 2 And I = 22 Then
Col = "G"
fcol = "F"
ElseIf K = 2 And I = 23 Then
Col = "G"
fcol = "H"
End If
Min = WS.Range("C" & I) - 4
Max = WS.Range("C" & I) + 4
For J = 11 To 20
If WS.Range(Col & J) >= Min And WS.Range(Col & J) <= Max Then
factor = WS.Range(Col & J).Offset(0, -2)
If factor = "Close Hits" Or factor = "Point Hits" Then factor = "Unity"
Exit For
End If
Next J
If factor <> "" Then
Set cCell = WS.Range("A50:A59").Find(what:=factor, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not cCell Is Nothing Then
WS.Cells(cCell.Row, fcol) = WS.Cells(cCell.Row, fcol) + 1
End If
factor = ""
End If
Next I
Next K
End If
WS.Range("B22") = WS.Range("H32")
WS.Range("B23") = WS.Range("I32")
WS.Range("B24") = WS.Range("J33")
WS.Range("B25") = WS.Range("K33")
WS.Range("B26") = WS.Range("L33")
WS.Range("B27") = WS.Range("G33")
WS.Range("B28") = WS.Range("B33")
WS.Range("C29") = WS.Range("A33")
'---> High
If WS.Range("C29") = "High" Then
WS.Range("L49") = WS.Range("L49") + 1
WS.Range("N49") = WS.Range("N49") + 1
WS.Range("P49") = WS.Range("P49") + 1
WS.Range("R49") = WS.Range("R49") + 1
WS.Range("T49") = WS.Range("T49") + 1
WS.Range("V49") = WS.Range("V49") + 1
'---> Step 02,03,04,05
For K = 1 To 3
For I = 22 To 23
If K = 1 And I = 22 Then
Col = "K"
fcol = "L"
ElseIf K = 1 And I = 23 Then
Col = "K"
fcol = "N"
ElseIf K = 2 And I = 22 Then
Col = "O"
fcol = "P"
ElseIf K = 2 And I = 23 Then
Col = "O"
fcol = "R"
ElseIf K = 3 And I = 22 Then
Col = "S"
fcol = "T"
ElseIf K = 3 And I = 23 Then
Col = "S"
fcol = "V"
End If
Min = WS.Range("C" & I) - 4
Max = WS.Range("C" & I) + 4
For J = 2 To 11
If WS.Range(Col & J) >= Min And WS.Range(Col & J) <= Max Then
factor = WS.Range(Col & J).Offset(0, -2)
If factor = "Range CC Hits" Or factor = "Range HL Hits" Or factor = "Range PC Hits" Then factor = "Unity"
Exit For
End If
Next J
If factor <> "" Then
Set cCell = WS.Range("K39:K48").Find(what:=factor, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not cCell Is Nothing Then
WS.Cells(cCell.Row, fcol) = WS.Cells(cCell.Row, fcol) + 1
End If
factor = ""
End If
Next I
Next K
End If
'---> Low
If WS.Range("C29") = "Low" Then
WS.Range("L60") = WS.Range("L60") + 1
WS.Range("N60") = WS.Range("N60") + 1
WS.Range("P60") = WS.Range("P60") + 1
WS.Range("R60") = WS.Range("R60") + 1
WS.Range("T60") = WS.Range("T60") + 1
WS.Range("V60") = WS.Range("V60") + 1
'---> Step 02,03,04,05
For K = 1 To 3
For I = 22 To 23
If K = 1 And I = 22 Then
Col = "K"
fcol = "L"
ElseIf K = 1 And I = 23 Then
Col = "K"
fcol = "N"
ElseIf K = 2 And I = 22 Then
Col = "O"
fcol = "P"
ElseIf K = 2 And I = 23 Then
Col = "O"
fcol = "R"
ElseIf K = 3 And I = 22 Then
Col = "S"
fcol = "T"
ElseIf K = 3 And I = 23 Then
Col = "S"
fcol = "V"
End If
Min = WS.Range("C" & I) - 4
Max = WS.Range("C" & I) + 4
For J = 11 To 20
If WS.Range(Col & J) >= Min And WS.Range(Col & J) <= Max Then
factor = WS.Range(Col & J).Offset(0, -2)
If factor = "Close Hits" Or factor = "Point Hits" Then factor = "Unity"
Exit For
End If
Next J
If factor <> "" Then
Set cCell = WS.Range("K50:K59").Find(what:=factor, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not cCell Is Nothing Then
WS.Cells(cCell.Row, fcol) = WS.Cells(cCell.Row, fcol) + 1
End If
factor = ""
End If
Next I
Next K
End If
WS.Range("B22") = WS.Range("H33")
WS.Range("B23") = WS.Range("I33")
WS.Range("B24") = WS.Range("J32")
WS.Range("B25") = WS.Range("K32")
WS.Range("B26") = WS.Range("L32")
WS.Range("B27") = WS.Range("G33")
WS.Range("B28") = WS.Range("B33")
WS.Range("C29") = WS.Range("A33")
'---> High
If WS.Range("C29") = "High" Then
WS.Range("L76") = WS.Range("L76") + 1
WS.Range("N76") = WS.Range("N76") + 1
WS.Range("P76") = WS.Range("P76") + 1
WS.Range("R76") = WS.Range("R76") + 1
WS.Range("T76") = WS.Range("T76") + 1
WS.Range("V76") = WS.Range("V76") + 1
'---> Step 02,03,04,05
For K = 1 To 3
For I = 22 To 23
If K = 1 And I = 22 Then
Col = "K"
fcol = "L"
ElseIf K = 1 And I = 23 Then
Col = "K"
fcol = "N"
ElseIf K = 2 And I = 22 Then
Col = "O"
fcol = "P"
ElseIf K = 2 And I = 23 Then
Col = "O"
fcol = "R"
ElseIf K = 3 And I = 22 Then
Col = "S"
fcol = "T"
ElseIf K = 3 And I = 23 Then
Col = "S"
fcol = "V"
End If
Min = WS.Range("C" & I) - 4
Max = WS.Range("C" & I) + 4
For J = 2 To 11
If WS.Range(Col & J) >= Min And WS.Range(Col & J) <= Max Then
factor = WS.Range(Col & J).Offset(0, -2)
If factor = "Range CC Hits" Or factor = "Range HL Hits" Or factor = "Range PC Hits" Then factor = "Unity"
Exit For
End If
Next J
If factor <> "" Then
Set cCell = WS.Range("K66:K75").Find(what:=factor, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not cCell Is Nothing Then
WS.Cells(cCell.Row, fcol) = WS.Cells(cCell.Row, fcol) + 1
End If
factor = ""
End If
Next I
Next K
End If
'---> Low
If WS.Range("C29") = "Low" Then
WS.Range("L87") = WS.Range("L87") + 1
WS.Range("N87") = WS.Range("N87") + 1
WS.Range("P87") = WS.Range("P87") + 1
WS.Range("R87") = WS.Range("R87") + 1
WS.Range("T87") = WS.Range("T87") + 1
WS.Range("V87") = WS.Range("V87") + 1
'---> Step 02,03,04,05
For K = 1 To 3
For I = 22 To 23
If K = 1 And I = 22 Then
Col = "K"
fcol = "L"
ElseIf K = 1 And I = 23 Then
Col = "K"
fcol = "N"
ElseIf K = 2 And I = 22 Then
Col = "O"
fcol = "P"
ElseIf K = 2 And I = 23 Then
Col = "O"
fcol = "R"
ElseIf K = 3 And I = 22 Then
Col = "S"
fcol = "T"
ElseIf K = 3 And I = 23 Then
Col = "S"
fcol = "V"
End If
Min = WS.Range("C" & I) - 4
Max = WS.Range("C" & I) + 4
For J = 11 To 20
If WS.Range(Col & J) >= Min And WS.Range(Col & J) <= Max Then
factor = WS.Range(Col & J).Offset(0, -2)
If factor = "Close Hits" Or factor = "Point Hits" Then factor = "Unity"
Exit For
End If
Next J
If factor <> "" Then
Set cCell = WS.Range("K77:K86").Find(what:=factor, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not cCell Is Nothing Then
WS.Cells(cCell.Row, fcol) = WS.Cells(cCell.Row, fcol) + 1
End If
factor = ""
End If
Next I
Next K
End If
WS.Range("B22") = WS.Range("H33")
WS.Range("B23") = WS.Range("I33")
WS.Range("B24") = WS.Range("J33")
WS.Range("B25") = WS.Range("K33")
WS.Range("B26") = WS.Range("L33")
WS.Range("B27") = WS.Range("G33")
WS.Range("B28") = WS.Range("B33")
WS.Range("C29") = WS.Range("A33")
'---> High
If WS.Range("C29") = "High" Then
WS.Range("L103") = WS.Range("L103") + 1
WS.Range("N103") = WS.Range("N103") + 1
WS.Range("P103") = WS.Range("P103") + 1
WS.Range("R103") = WS.Range("R103") + 1
WS.Range("T103") = WS.Range("T103") + 1
WS.Range("V103") = WS.Range("V103") + 1
'---> Step 02,03,04,05
For K = 1 To 3
For I = 22 To 23
If K = 1 And I = 22 Then
Col = "K"
fcol = "L"
ElseIf K = 1 And I = 23 Then
Col = "K"
fcol = "N"
ElseIf K = 2 And I = 22 Then
Col = "O"
fcol = "P"
ElseIf K = 2 And I = 23 Then
Col = "O"
fcol = "R"
ElseIf K = 3 And I = 22 Then
Col = "S"
fcol = "T"
ElseIf K = 3 And I = 23 Then
Col = "S"
fcol = "V"
End If
Min = WS.Range("C" & I) - 4
Max = WS.Range("C" & I) + 4
For J = 2 To 11
If WS.Range(Col & J) >= Min And WS.Range(Col & J) <= Max Then
factor = WS.Range(Col & J).Offset(0, -2)
If factor = "Range CC Hits" Or factor = "Range HL Hits" Or factor = "Range PC Hits" Then factor = "Unity"
Exit For
End If
Next J
If factor <> "" Then
Set cCell = WS.Range("K93:K102").Find(what:=factor, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not cCell Is Nothing Then
WS.Cells(cCell.Row, fcol) = WS.Cells(cCell.Row, fcol) + 1
End If
factor = ""
End If
Next I
Next K
End If
'---> Low
If WS.Range("C29") = "Low" Then
WS.Range("L114") = WS.Range("L114") + 1
WS.Range("N114") = WS.Range("N114") + 1
WS.Range("P114") = WS.Range("P114") + 1
WS.Range("R114") = WS.Range("R114") + 1
WS.Range("T114") = WS.Range("T114") + 1
WS.Range("V114") = WS.Range("V114") + 1
'---> Step 02,03,04,05
For K = 1 To 3
For I = 22 To 23
If K = 1 And I = 22 Then
Col = "K"
fcol = "L"
ElseIf K = 1 And I = 23 Then
Col = "K"
fcol = "N"
ElseIf K = 2 And I = 22 Then
Col = "O"
fcol = "P"
ElseIf K = 2 And I = 23 Then
Col = "O"
fcol = "R"
ElseIf K = 3 And I = 22 Then
Col = "S"
fcol = "T"
ElseIf K = 3 And I = 23 Then
Col = "S"
fcol = "V"
End If
Min = WS.Range("C" & I) - 4
Max = WS.Range("C" & I) + 4
For J = 11 To 20
If WS.Range(Col & J) >= Min And WS.Range(Col & J) <= Max Then
factor = WS.Range(Col & J).Offset(0, -2)
If factor = "Close Hits" Or factor = "Point Hits" Then factor = "Unity"
Exit For
End If
Next J
If factor <> "" Then
Set cCell = WS.Range("K104:K113").Find(what:=factor, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not cCell Is Nothing Then
WS.Cells(cCell.Row, fcol) = WS.Cells(cCell.Row, fcol) + 1
End If
factor = ""
End If
Next I
Next K
End If
WS.Range("B22") = WS.Range("H33")
WS.Range("B23") = WS.Range("I33")
WS.Range("B24") = WS.Range("J33")
WS.Range("B25") = WS.Range("K33")
WS.Range("B26") = WS.Range("L33")
WS.Range("B27") = WS.Range("G32")
WS.Range("B28") = WS.Range("B32")
WS.Range("C29") = WS.Range("A33")
'---> High
If WS.Range("C29") = "High" Then
WS.Range("B76") = WS.Range("B76") + 1
WS.Range("D76") = WS.Range("D76") + 1
WS.Range("F76") = WS.Range("F76") + 1
WS.Range("H76") = WS.Range("H76") + 1
'---> Step 02,03,04,05
For K = 1 To 2
For I = 22 To 23
If K = 1 And I = 22 Then
Col = "C"
fcol = "B"
ElseIf K = 1 And I = 23 Then
Col = "C"
fcol = "D"
ElseIf K = 2 And I = 22 Then
Col = "G"
fcol = "F"
ElseIf K = 2 And I = 23 Then
Col = "G"
fcol = "H"
End If
Min = WS.Range("C" & I) - 4
Max = WS.Range("C" & I) + 4
For J = 2 To 11
If WS.Range(Col & J) >= Min And WS.Range(Col & J) <= Max Then
factor = WS.Range(Col & J).Offset(0, -2)
If factor = "Close Hits" Or factor = "Point Hits" Then factor = "Unity"
Exit For
End If
Next J
If factor <> "" Then
Set cCell = WS.Range("A66:A75").Find(what:=factor, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not cCell Is Nothing Then
WS.Cells(cCell.Row, fcol) = WS.Cells(cCell.Row, fcol) + 1
End If
factor = ""
End If
Next I
Next K
End If
'---> Low
If WS.Range("C29") = "Low" Then
WS.Range("B87") = WS.Range("B87") + 1
WS.Range("D87") = WS.Range("D87") + 1
WS.Range("F87") = WS.Range("F87") + 1
WS.Range("H87") = WS.Range("H87") + 1
'---> Step 02,03,04,05
For K = 1 To 2
For I = 22 To 23
If K = 1 And I = 22 Then
Col = "C"
fcol = "B"
ElseIf K = 1 And I = 23 Then
Col = "C"
fcol = "D"
ElseIf K = 2 And I = 22 Then
Col = "G"
fcol = "F"
ElseIf K = 2 And I = 23 Then
Col = "G"
fcol = "H"
End If
Min = WS.Range("C" & I) - 4
Max = WS.Range("C" & I) + 4
For J = 11 To 20
If WS.Range(Col & J) >= Min And WS.Range(Col & J) <= Max Then
factor = WS.Range(Col & J).Offset(0, -2)
If factor = "Close Hits" Or factor = "Point Hits" Then factor = "Unity"
Exit For
End If
Next J
If factor <> "" Then
Set cCell = WS.Range("A77:A86").Find(what:=factor, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not cCell Is Nothing Then
WS.Cells(cCell.Row, fcol) = WS.Cells(cCell.Row, fcol) + 1
End If
factor = ""
End If
Next I
Next K
End If
WS.Range("B22:B28").ClearContents
WS.Range("C29").ClearContents
End Sub
Update Ranges i.e. WS.Range("B22") = WS.Range("H33")
WS.Range("B23") = WS.Range("I33")
WS.Range("B27") = WS.Range("B33")
WS.Range("B28") = WS.Range("G33")
WS.Range("C29") = WS.Range("A33")
like if you go left right then down then left right then down ???
as you have
1 2
5 3
4
WS.Range("B22") = WS.Range("H33")
WS.Range("B23") = WS.Range("I33")
WS.Range("B27") = WS.Range("B33")
WS.Range("B28") = WS.Range("G33")
WS.Range("C29") = WS.Range("A33")
WS.Range("B22") = WS.Range("H32")
WS.Range("B23") = WS.Range("I32")
WS.Range("B24") = WS.Range("J33")
WS.Range("B25") = WS.Range("K33")
WS.Range("B26") = WS.Range("L33")
WS.Range("B27") = WS.Range("G33")
WS.Range("B28") = WS.Range("B33")
WS.Range("C29") = WS.Range("A33")
WS.Range("B22") = WS.Range("H33")
WS.Range("B23") = WS.Range("I33")
WS.Range("B24") = WS.Range("J32")
WS.Range("B25") = WS.Range("K32")
WS.Range("B26") = WS.Range("L32")
WS.Range("B27") = WS.Range("G33")
WS.Range("B28") = WS.Range("B33")
WS.Range("C29") = WS.Range("A33")
WS.Range("B22") = WS.Range("H33")
WS.Range("B23") = WS.Range("I33")
WS.Range("B24") = WS.Range("J33")
WS.Range("B25") = WS.Range("K33")
WS.Range("B26") = WS.Range("L33")
WS.Range("B27") = WS.Range("G33")
WS.Range("B28") = WS.Range("B33")
WS.Range("C29") = WS.Range("A33")
WS.Range("B22") = WS.Range("H33")
WS.Range("B23") = WS.Range("I33")
WS.Range("B24") = WS.Range("J33")
WS.Range("B25") = WS.Range("K33")
WS.Range("B26") = WS.Range("L33")
WS.Range("B27") = WS.Range("G32")
WS.Range("B28") = WS.Range("B32")
WS.Range("C29") = WS.Range("A33")
hey Expert one question do u know why WBC count increases ?
i don't know why my WBC count doubled then normal range from last two day & still i dint find nothing unusual in body. :)
Copy Cell Value H33 Past To B22
Copy Cell Value I33 Past To B23
Copy Cell Value B33 Past To B27
Copy Cell Value G33 Past To B28
Copy Cell Value A33 Past To C29
If C29 = "High" then +1 @ Cell B76 & D76 & F76 & H76
If C29="Low" then +1 @ CellB87 & D87 & F87 & H87
If C29="High" then Find C22 Value From Range C2:C10(+ or - 4 Point Leverage)
"If True then find Respective factor in range B39:B48& Add +1 (if it is at Range CC then put +1 @ Unity)else nothing next step
"
If C29="Low" then Find C22 Value From Range C12:C20(+ or - 4 Point Leverage)
"If True then find Respective factor in range B49:B57& Add +1 (if it is at Range CC then put +1 @ Unity)else nothing next step
"
If C29="High" then Find C23 value in range C2:C11(+ or - 4 Point Leverage)
"If True then find Respective factor in range D39:D48& Add +1 (if it is at Range CC then put +1 @ Unity)else nothing next step
"
If C29="Low" then Find C23 Value From Range C12:C20(+ or - 4 Point Leverage)
"If True then find Respective factor in range D49:D57& Add +1 (if it is at Range CC then put +1 @ Unity)else nothing next step
"
or separated for High & low for each pass? this is only for High for one of the pass
Copy Cell Value H33 Past To B22
Copy Cell Value I33 Past To B23
Copy Cell Value B33 Past To B27
Copy Cell Value G33 Past To B28
Copy Cell Value A33 Past To C29
If C29 = "High" then +1 @ Cell B76 & D76 & F76 & H76
If C29="High" then Find C22 Value From Range C2:C10(+ or - 4 Point Leverage)
"If True then find Respective factor in range B39:B48& Add +1 (if it is at Range CC then put +1 @ Unity)else nothing next step
"
If C29="High" then Find C23 value in range C2:C11(+ or - 4 Point Leverage)
"If True then find Respective factor in range D39:D48& Add +1 (if it is at Range CC then put +1 @ Unity)else nothing next step
"
Copy Cell Value H33 Past To B22
Copy Cell Value I33 Past To B23
Copy Cell Value B33 Past To B27
Copy Cell Value G33 Past To B28
Copy Cell Value A33 Past To C29
this Step 1 for pass 1.If C29 = "High" then +1 @ Cell B49 & D49 & F49 & H49
If C29="Low" then +1 @ CellB60 & D60 & F60 & H60
Step 2 Pass 1last text file is fine. Let me digest all this, and maybe at the end .....
will see
Sub Analyse()
Dim WS As Worksheet
Set WS = ThisWorkbook.ActiveSheet
Analyse_Pass1 WS
Analyse_Pass2 WS
Analyse_Pass3 WS
Analyse_Pass4 WS
Analyse_Pass5 WS
WS.Range("B22:B28").ClearContents
WS.Range("C29").ClearContents
End Sub
If you are experiencing a similar issue, please ask a related question
Join the community of 500,000 technology professionals and ask your questions.