For low you need to post as so many references although I did the last one but was not obvious.
I cannot act as asker and give answers !!! at the same time
gowflow
this one is 4 points leverage whereas the previous was 3 points leverage but at one point you said 4 points and what was posted was 4 points so what is it now ??
For low you need to post as so many references although I did the last one but was not obvious.Sure I will.
only one button "Analyze" for this question
& only one button for process WB path C:\Data G\ "Process Workbook" which is my next question
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 = ActiveSheet
'---> Step 1 Call for Pre Time Range With Current Price Range
PTRwCPR
'---> Step 2 check if High or Low
' Step 2 - High
'1
'If C29 = ”High” Then
'+1 @ Cell B49 & D49 & F49 & H49 & L49 & N49 & P49 & R49 & T49 & V49
'2
'Find C22 Value from Range C2:C11 (+ or – 4 point leverage)
'if True then find respective factor in range B39:B48 & Add +1 (if it is at Close Hits then put +1 @ Unity)else nothing next step
'3
'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 Close Hits then put +1 @ Unity )else nothing next step
'4
'Find C22 value from range G2:G11(+ or – 4 point leverage)
'if true then find respective factor in range F39:F48 & Add +1 (if it is at Point Hits then put +1 @ Unity )else nothing next step
'5
'Find C23 value from range G2:G11(+ or – 4 point leverage)
'if true then find respective factor in range H39:H48 & Add +1 (if it is at Point Hits then put +1 @ Unity )else nothing. End
'6
'Find C22 Value from Range K2:K11 (+ or – 4 point leverage)
'if True then find respective factor in range L39:L48 & Add +1 (if it is at Range CC then put +1 @ Unity)else nothing next step
'7
'Find C23 Value in Range K2:K11(+ or – 4 point leverage)
'if true then find respective factor in range N39:N48 & Add +1(if it is at Range CC then put +1 @ Unity )else nothing next step
'8
'Find C22 value from range O2:O11(+ or – 4 point leverage)
'if true then find respective factor in range P39:P48 & Add +1 (if it is at Range HL then put +1 @ Unity )else nothing next step
'9
'Find C23 value from range O2:O11(+ or – 4 point leverage)
'if true then find respective factor in range R39:R48 & Add +1 (if it is at Range HL then put +1 @ Unity )else nothing.
'10
'Find C22 value from range S2:S11(+ or – 4 point leverage)
'if true then find respective factor in range T39:T48 & Add +1 (if it is at Rang PC then put +1 @ Unity )else nothing next step
'11
'Find C23 value from range S2:S11(+ or – 4 point leverage)
'if true then find respective factor in range V39:V48 & Add +1 (if it is at Range PC then put +1 @ Unity )else nothing
'End
'---> 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
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
'---> Items 02,03,04,05,06,07,08,09,10,11
For K = 1 To 5
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"
ElseIf K = 3 And I = 22 Then
Col = "K"
fcol = "L"
ElseIf K = 3 And I = 23 Then
Col = "K"
fcol = "N"
ElseIf K = 4 And I = 22 Then
Col = "O"
fcol = "P"
ElseIf K = 4 And I = 23 Then
Col = "O"
fcol = "R"
ElseIf K = 5 And I = 22 Then
Col = "S"
fcol = "T"
ElseIf K = 5 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)
Select Case factor
Case "Close Hits", "Point Hits", "Range CC", "Range HL", "Range PC"
factor = "Unity"
End Select
Exit For
End If
Next J
If factor <> "" Then
Set cCell = WS.Range("A39:A49").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
'---> Step 2 check if High or Low
' Step 2 - Low
'1
'On Button click analyze
'If C29 = ”Low” Then
'+1 @ Cell B60 & D60 & F60 & H60 & L60 & N60 & P60 & R60 & T60 & V60
'2
'Find C22 Value from Range C11:C20 (+ or – 4 point leverage)
'if True then find respective factor in range B50:B59 & Add +1 (if it is at Close Hits then put +1 @ Unity)else nothing next step
'3
'Find C23 Value in Range C11:C20(+ or – 4 point leverage)
'if true then find respective factor in range D50:D59 & Add +1(if it is at Close Hits then put +1 @ Unity )else nothing next step
'4
'Find C22 value from range G11:G20(+ or – 4 point leverage)
'if true then find respective factor in range F50:F59 & Add +1 (if it is at Point Hits then put +1 @ Unity )else nothing next step
'5
'Find C23 value from range G11:G20(+ or – 4 point leverage)
'if true then find respective factor in range H50:H59 & Add +1 (if it is at Point Hits then put +1 @ Unity )else nothing. End
'6
'Find C22 Value from Range K11:K20 (+ or – 4 point leverage)
'if True then find respective factor in range L50:L59 & Add +1 (if it is at Range CC then put +1 @ Unity)else nothing next step
'7
'Find C23 Value in Range K11:K20(+ or – 4 point leverage)
'if true then find respective factor in range N50:N59 & Add +1(if it is at Range CC then put +1 @ Unity )else nothing next step
'8
'Find C22 value from range O11:O20(+ or – 4 point leverage)
'if true then find respective factor in range P50:P59 & Add +1 (if it is at Range HL then put +1 @ Unity )else nothing next step
'9
'Find C23 value from range O11:O20(+ or – 4 point leverage)
'if true then find respective factor in range R50:R59 & Add +1 (if it is at Range HL then put +1 @ Unity )else nothing.
'10
'Find C22 value from range S11:S20(+ or – 4 point leverage)
'if true then find respective factor in range T50:T59 & Add +1 (if it is at Rang PC then put +1 @ Unity )else nothing next step
'11
'Find C23 value from range S11:S20(+ or – 4 point leverage)
'if true then find respective factor in range V50:V59 & Add +1 (if it is at Range PC then put +1 @ Unity )else nothing
'End
'---> 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
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 5
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"
ElseIf K = 3 And I = 22 Then
Col = "K"
fcol = "L"
ElseIf K = 3 And I = 23 Then
Col = "K"
fcol = "N"
ElseIf K = 4 And I = 22 Then
Col = "O"
fcol = "P"
ElseIf K = 4 And I = 23 Then
Col = "O"
fcol = "R"
ElseIf K = 5 And I = 22 Then
Col = "S"
fcol = "T"
ElseIf K = 5 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)
Select Case factor
Case "Close Hits", "Point Hits", "Range CC", "Range HL", "Range PC"
factor = "Unity"
End Select
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
End Sub
Sub PTRwCPR()
Dim WS As Worksheet
Set WS = ActiveSheet
'---> Transfer Previous Time Range with Current Price Range
WS.Range("C29") = WS.Range("A33")
WS.Range("B28") = WS.Range("B33")
WS.Range("B27") = WS.Range("G33")
WS.Range("B26") = WS.Range("L33")
WS.Range("B25") = WS.Range("K33")
WS.Range("B24") = WS.Range("J33")
WS.Range("B23") = WS.Range("I32")
WS.Range("B22") = WS.Range("H32")
End Sub
Sub ClearData()
Dim WS As Worksheet
Set WS = ActiveSheet
'---> Clear Data from Scoring Table
WS.Range("B39:B60").ClearContents
WS.Range("D39:D60").ClearContents
WS.Range("F39:F60").ClearContents
WS.Range("H39:H60").ClearContents
WS.Range("L39:L60").ClearContents
WS.Range("N39:N60").ClearContents
WS.Range("P39:P60").ClearContents
WS.Range("R39:R60").ClearContents
WS.Range("T39:T60").ClearContents
WS.Range("V39:V60").ClearContents
End Sub
Sub ProcessWorkbook()
Dim WB As Workbook
Dim WS As Worksheet
Dim ThisWS As Worksheet
Dim MaxRow As Long, I As Long, lCount As Long
Dim WBName As String
With Application
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
End With
'---> Replace this with the exact path and file name of your file
WBName = "C:\Data G\xyz.xlsx"
'WBName = "C:\Users\JGE002\Desktop\EE Projects\itjockey\13 Scoring part3\xyz.xlsx"
Set ThisWS = ActiveSheet
Set WB = Workbooks.Open(WBName)
Set WS = WB.ActiveSheet
MaxRow = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
For I = 3 To MaxRow
WS.Range("A" & I & ":L" & I + 1).Copy
ThisWS.Activate
ThisWS.Range("A32").PasteSpecial xlPasteValues
Analyse
lCount = lCount + 1
DoEvents
Next I
WB.Close savechanges:=False
Set WB = Nothing
Set WS = Nothing
With Application
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
End With
MsgBox ("Analyse and Import of entire workbook completed successfully for " & lCount & " points.")
End Sub
Title | # Comments | Views | Activity |
---|---|---|---|
vb6, excel Run-time error 1004 method 'close' of object 'workbooks' failed | 7 | 30 | |
AutoFilter Delete not keeping Headers? | 2 | 12 | |
userform submit button saving document, but not imputting data into worksheets | 12 | 25 | |
Excel filter by strike though | 8 | 24 |
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
10 Experts available now in Live!