Extracting data on the basis of multiple conditions

[Rahul87]

Hi Experts, once again thank you very much for helping me in achieving my tasks. Once again I posting here to get another tasks to be done. Please have a look on below requirements and if possible then please help me out.

Any help would be highly appreciated.

In my sheet there are eight columns A, B, C, D, E, F, G, H with heading as Trading Symbol, LTP, ATP, Recorded ATP, Rate, TSL, Reconsideration, and Rank as below.

I want to fetch out the number of data (only Trading symbols) from column A as mentioned by the user in integer value in Cell V5 as (1,2,3.......) for positioning of data in vertical order and also to provide position or rank as 1, 2, 3.... and so on vertically from cell U18,V18.... for ranking or serial number or for positioning as below, and similarly U19, V19.... for trading symbol.

1	2	3	4
BHEL23APRFUT	CHAMBLFERT23APRFUT	BAJAJFINSV23APRFUT	HDFC23APRFUT

on the basis of below criteria, which will be defined by the user only in other columns/cell as like below snap:-

data should be fetched out and pasted horizontally from Cell U19, V19.........
if percentage value in column E (Rate) is greater than value of Cell V8
and if column B (LTP) value is greater than column G (Reconsideration) And column H (Rank) value is less than or equals to cell value of V5
and if any of the position value in vertical order is vacant then only it should fill the vacant position at last and it should replace or move the existing trading symbol above only when the rank in column H is greater than the out of rank value of Cell V9 and if Value of column B is less than value of column F.

Below is the code, which I am was able to search and build with help of internet, but unable to get it done.

Please help me out in achieving the task. if not understood then please post, I will make it more clear.

Private Sub Worksheet_Change(ByVal Target As Range)
StartTimer

Application.ScreenUpdating = False
Application.EnableEvents = False

Dim dataRange As Range
Set dataRange = Range("A2:H" & Cells(Rows.Count, "H").End(xlUp).Row)

If Target.Address = "$V$5" Then
    'Check if the entered value is an integer and not empty and not zero
    If IsNumeric(Target.Value) And Target.Value <> "" And Target.Value <> 0 And Int(Target.Value) = Target.Value Then
        'Get the threshold, consideration, maxRank, and position values from the worksheet
        Dim threshold As Double
        threshold = Range("V8").Value
        Dim consideration As Double
        consideration = Range("G1").Value
        Dim maxRank As Long
        maxRank = Range("V5").Value
        Dim outOfRank As Long
        outOfRank = Range("V9").Value
        Dim position As Long
        position = Range("V5").Value
        
        'Initialize the row counter for writing data to the output range
        Dim outputRow As Long
        outputRow = 19
        
        'Initialize the serial number
        Dim serialNumber As Long
        serialNumber = 1
        
        'Loop through the rows in the data range
        Dim i As Long
        For i = 1 To dataRange.Rows.Count
            'Check if the percentage value in the E column is greater than the threshold
            If dataRange(i, 5).Value > threshold Then
                'Check if the LTP column value is greater than the consideration value
                If dataRange(i, 2).Value > consideration Then
                    'Check if the Rank column value is less than or equal to the maxRank value
                    If dataRange(i, 8).Value <= maxRank Then
                        'Check if the position value in the vertical order is vacant
                        If Range("V" & (position + 18)).Value = "" Then
                            'Write the serial number and Trading Symbol horizontally to the output range starting at V19
                            Range("U" & outputRow).Value = serialNumber
                            Range("V" & outputRow).Value = dataRange(i, 1).Value
                            'Increment the row and serial number
                            outputRow = outputRow + 1
                            serialNumber = serialNumber + 1
                        'If the position value in the vertical order is not vacant, check if the rank is greater than the outOfRank value and if the LTP is less than TSL
                        ElseIf dataRange(i, 8).Value > outOfRank And dataRange(i, 2).Value < dataRange(i, 6).Value Then
                            'Find the next vacant position in the vertical order
                            Do While Range("V" & (position + 18)).Value <> ""
                                position = position + 1
                            Loop
                            'Write the serial number and Trading Symbol horizontally to the vacant position in the vertical order
                            Range("U" & (position + 18)).Value = serialNumber
                            Range("V" & (position + 18)).Value = dataRange(i, 1).Value
                            'Increment the serial number
                            serialNumber = serialNumber + 1
                        End If
                    End If
                End If
            End If
        Next i
    End If
End If

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[OaklandJim]

Are you willing to post a link to your workbook? Otherwise, someone willing to assist will need to recreate it...unlikely. Use the link icon above the message area. Also, please use Mr Excel's excellent addin to post the part of your worksheet that contains data. That way someone helping does not have to create the data. See HERE.

 

[Rahul87]

Are you willing to post a link to your workbook? Otherwise, someone willing to assist will need to recreate it...unlikely. Use the link icon above the message area. Also, please use Mr Excel's excellent addin to post the part of your worksheet that contains data. That way someone helping does not have to create the data. See HERE.

Hi @OaklandJim , thank you for your suggestion. Kindly find the below link so that you can see my data.

Link to download the file

Please do let me know if else required.

 

[OaklandJim]

I really wish that I could assist. But, I tried understanding your workbook and not much is clear to me including what the workbook does and what you need assistance with.

First, the VBA project is password protected. So looking at your macros is not possible. (I'm not even sure that that would help me to understand your need).

And, when trying to understand what your buttons do I kept getting the error message telling me that I need to enter an interval. If I do enter an interval (e.g. 2 Seconds) I get errors that I cannot trace given that I do not have access to the project.

And your Sheet1 has nothing but #N/A errors.

 

[Rahul87]

I really wish that I could assist. But, I tried understanding your workbook and not much is clear to me including what the workbook does and what you need assistance with.

First, the VBA project is password protected. So looking at your macros is not possible. (I'm not even sure that that would help me to understand your need).

And, when trying to understand what your buttons do I kept getting the error message telling me that I need to enter an interval. If I do enter an interval (e.g. 2 Seconds) I get errors that I cannot trace given that I do not have access to the project.

And your Sheet1 has nothing but #N/A errors.

@OaklandJim, Sorry to hear from you that, please check my another link and please ignore the Sheet 1, that is nothing. I uploaded the new file without password, can you please check, and it is very simple made, and I can make you understand very clearly that what all buttons were doing.

1. The first button with name of Record ATP----it will just copy the data of C column and M column and paste it into the D column and N column respectively.
2. Start button is just to start the all the function, which includes shorting, copy, pasting, and updating, but only when there is integer value in Cell V3, in seconds.
3. Stop button is to stop the timer.
4. Reset All Button is to clear the data, from respective columns, which you can see in code.
5. Same Reset long Rank and Reset Short Rank buttons are just only to clear the data from some range.

Next the thing what I want to achieve is getting me in trouble, which you can see in the sheet only I have highlighted with yellow, that's why I am seeking help from you. Please help me out.

Below is the link of my file without password, once you will see it, you will understand.
Link to download the new file

Please do let me know if not understood this time.

 

[OaklandJim]

Your worksheet change event code crashes so I could not even get started. Says there is a missing EndIf somewhere.

I rewrote the code as below to try to understand what the code does. I'm not sure that I do.

Question: is the code for the change event supposed to do what you need? Or is that a separate sub?

Anyway, I THINK that I got the End If statements in the right place. Before I do anything else please confirm that this code does what YOUR version was supposed to do.

After that I'll try again to understand what you are after.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    'StartTimer

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim rDataRange As Range
    
    Dim dThreshold As Double
    
    Dim vConsideration As Variant
    
    Dim iMaxRank As Long
    
    Dim iOutOfRank As Long
    
    Dim iPosition As Long

    Dim iOutputRow As Long
    
    Dim iSerialNumber As Long
    
    Dim iOuterLoopIndex As Long
    
    Dim iInnerLoopIndex As Long
            
    Set rDataRange = Range("A2:H" & Cells(Rows.Count, "H").End(xlUp).Row)

    If Target.Address = "$V$5" Then
    
'       Check if the entered value is an integer and not empty and not zero
        If IsNumeric(Target.Value) And Target.Value <> "" And Target.Value <> 0 And Int(Target.Value) = Target.Value Then

'           Get the threshold, consideration, iMaxRank, and iPosition values from the worksheet
            dThreshold = Range("V8").Value
            
            vConsideration = Range("G2:G" & Cells(Rows.Count, "G").End(xlUp).Row).Value
            
            iMaxRank = Range("V5").Value '<= same as iPosition?
            
            iOutOfRank = Range("V9").Value
            
            iPosition = Range("V5").Value  '<= same as iMaxRank?
            
'           Initialize the row counter for writing data to the output range
            iOutputRow = 19
            
'           Initialize the serial number
            iSerialNumber = 1
            
'           Loop through the rows in the data range
            For iOuterLoopIndex = 1 To rDataRange.Rows.Count
            
'               Check if the percentage value in the E column is greater than the threshold
                If rDataRange(iOuterLoopIndex, 5).Value > dThreshold Then

'                   Check if the LTP column value is greater than the consideration value
                    For iInnerLoopIndex = 1 To UBound(vConsideration)
                    
                        If rDataRange(iOuterLoopIndex, 2).Value > vConsideration(iInnerLoopIndex, 1) Then
                        
'                           Check if the Rank column value is less than or equal to the iMaxRank value
                            If rDataRange(iOuterLoopIndex, 8).Value <= iMaxRank Then

'                               Check if the position value in the vertical order is vacant
                                If Range("V" & (iPosition + 18)).Value = "" Then
                                
'                                   Write the serial number and Trading Symbol horizontally to the output range starting at V19
                                    Range("U" & iOutputRow).Value = iSerialNumber
                                    Range("V" & iOutputRow).Value = rDataRange(iOuterLoopIndex, 1).Value

'                                   Increment the row and serial number
                                    iOutputRow = iOutputRow + 1
                                    iSerialNumber = iSerialNumber + 1

'                               If the position value in the vertical order is not vacant, check if the rank is greater than the iOutOfRank value and if the LTP is less than TSL
                                ElseIf rDataRange(iOuterLoopIndex, 8).Value > iOutOfRank And rDataRange(iOuterLoopIndex, 2).Value < rDataRange(iOuterLoopIndex, 6).Value Then

'                                   Find the next vacant position in the vertical order
                                    Do While Range("V" & (iPosition + 18)).Value <> ""
                                        iPosition = iPosition + 1
                                    Loop

'                                   Write the serial number and Trading Symbol horizontally to the vacant position in the vertical order
                                    Range("U" & (iPosition + 18)).Value = iSerialNumber
                                    Range("V" & (iPosition + 18)).Value = rDataRange(iOuterLoopIndex, 1).Value

'                                   Increment the serial number
                                    iSerialNumber = iSerialNumber + 1
                                
                                End If 'rDataRange(iOuterLoopIndex, 8).Value <= iMaxRank
                            
                            End If 'rDataRange(iOuterLoopIndex, 2).Value > vConsideration(iInnerLoopIndex, 1)
                        
                        End If 'rDataRange(iOuterLoopIndex, 2).Value > vConsideration(iInnerLoopIndex, 1)
                    
                    Next iInnerLoopIndex
                           
                End If 'rDataRange(iOuterLoopIndex, 5).Value > dThreshold
                       
            Next iOuterLoopIndex
        
        End If 'IsNumeric(Target.Value) And Target.Value <> "" And Target.Value <> 0 And Int(Target.Value) = Target.Value
    
    End If 'Target.Address = "$V$5"

    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

 

[Rahul87]

Your worksheet change event code crashes so I could not even get started. Says there is a missing EndIf somewhere.

I rewrote the code as below to try to understand what the code does. I'm not sure that I do.

Question: is the code for the change event supposed to do what you need? Or is that a separate sub?

Anyway, I THINK that I got the End If statements in the right place. Before I do anything else please confirm that this code does what YOUR version was supposed to do.

After that I'll try again to understand what you are after.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    'StartTimer

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim rDataRange As Range
   
    Dim dThreshold As Double
   
    Dim vConsideration As Variant
   
    Dim iMaxRank As Long
   
    Dim iOutOfRank As Long
   
    Dim iPosition As Long

    Dim iOutputRow As Long
   
    Dim iSerialNumber As Long
   
    Dim iOuterLoopIndex As Long
   
    Dim iInnerLoopIndex As Long
           
    Set rDataRange = Range("A2:H" & Cells(Rows.Count, "H").End(xlUp).Row)

    If Target.Address = "$V$5" Then
   
'       Check if the entered value is an integer and not empty and not zero
        If IsNumeric(Target.Value) And Target.Value <> "" And Target.Value <> 0 And Int(Target.Value) = Target.Value Then

'           Get the threshold, consideration, iMaxRank, and iPosition values from the worksheet
            dThreshold = Range("V8").Value
           
            vConsideration = Range("G2:G" & Cells(Rows.Count, "G").End(xlUp).Row).Value
           
            iMaxRank = Range("V5").Value '<= same as iPosition?
           
            iOutOfRank = Range("V9").Value
           
            iPosition = Range("V5").Value  '<= same as iMaxRank?
           
'           Initialize the row counter for writing data to the output range
            iOutputRow = 19
           
'           Initialize the serial number
            iSerialNumber = 1
           
'           Loop through the rows in the data range
            For iOuterLoopIndex = 1 To rDataRange.Rows.Count
           
'               Check if the percentage value in the E column is greater than the threshold
                If rDataRange(iOuterLoopIndex, 5).Value > dThreshold Then

'                   Check if the LTP column value is greater than the consideration value
                    For iInnerLoopIndex = 1 To UBound(vConsideration)
                   
                        If rDataRange(iOuterLoopIndex, 2).Value > vConsideration(iInnerLoopIndex, 1) Then
                       
'                           Check if the Rank column value is less than or equal to the iMaxRank value
                            If rDataRange(iOuterLoopIndex, 8).Value <= iMaxRank Then

'                               Check if the position value in the vertical order is vacant
                                If Range("V" & (iPosition + 18)).Value = "" Then
                               
'                                   Write the serial number and Trading Symbol horizontally to the output range starting at V19
                                    Range("U" & iOutputRow).Value = iSerialNumber
                                    Range("V" & iOutputRow).Value = rDataRange(iOuterLoopIndex, 1).Value

'                                   Increment the row and serial number
                                    iOutputRow = iOutputRow + 1
                                    iSerialNumber = iSerialNumber + 1

'                               If the position value in the vertical order is not vacant, check if the rank is greater than the iOutOfRank value and if the LTP is less than TSL
                                ElseIf rDataRange(iOuterLoopIndex, 8).Value > iOutOfRank And rDataRange(iOuterLoopIndex, 2).Value < rDataRange(iOuterLoopIndex, 6).Value Then

'                                   Find the next vacant position in the vertical order
                                    Do While Range("V" & (iPosition + 18)).Value <> ""
                                        iPosition = iPosition + 1
                                    Loop

'                                   Write the serial number and Trading Symbol horizontally to the vacant position in the vertical order
                                    Range("U" & (iPosition + 18)).Value = iSerialNumber
                                    Range("V" & (iPosition + 18)).Value = rDataRange(iOuterLoopIndex, 1).Value

'                                   Increment the serial number
                                    iSerialNumber = iSerialNumber + 1
                               
                                End If 'rDataRange(iOuterLoopIndex, 8).Value <= iMaxRank
                           
                            End If 'rDataRange(iOuterLoopIndex, 2).Value > vConsideration(iInnerLoopIndex, 1)
                       
                        End If 'rDataRange(iOuterLoopIndex, 2).Value > vConsideration(iInnerLoopIndex, 1)
                   
                    Next iInnerLoopIndex
                          
                End If 'rDataRange(iOuterLoopIndex, 5).Value > dThreshold
                      
            Next iOuterLoopIndex
       
        End If 'IsNumeric(Target.Value) And Target.Value <> "" And Target.Value <> 0 And Int(Target.Value) = Target.Value
   
    End If 'Target.Address = "$V$5"

    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

@OaklandJim, Thank you very much for helping me Jim, but sorry to say, I can't figure it out that why the code is not working when User Input value in V5 cell. And Yes, the question you asked "The code for the change event supposed to do what you need? Or is that a separate sub?", is true to say that the code should run only when the User Inserted any value in Cell V5, else it should not work. Please see if it can be figure out. Thanks Very Much for the help.

 

[OaklandJim]

I apologize but we have a language problem. I'm trying to understand.

The code that I provided only runs when user changes cell V5.

    If Target.Address = "$V$5" Then

BUT, your code does not work. Mine does.

Question 1: Does my code looks seem like code that you were trying to write before?

Question 2: Is it that code -- the worksheet change event code -- that is supposed to do what is needed (if user changes cell V5)?

 

[OaklandJim]

Restated Question 1. Does my code seem like the code that you provided in the workbook link?

 

[OaklandJim]

For Long Rank I tried to find rows in your data that meet your selection criteria. Of the data that you provided are their any rows that meet all of your selection critreia?

Does what I have below seem like I understand which Long Rank rows to select?

'Include data for for long rank
'If Rate percentage (in column E) of a stock is greater than Threshold value of Cell (V8)
'And
'If LTP (in column B) value is greater than reconsideration (in column G)
'And
'IF Rank (in Column H) is less than or equal to cell value of V5.

            If dRatePercent > rThresholdCell.Value _
               And dLTP > dReconsideration _
               And iRank <= rLongRankCell.Value _
             Then
                iFoundCount = iFoundCount + 1

            End If