delete numbers if repeated 3 times (remove duplicates)

[Showroom]

Hi all,

I have a problem, and I was hoping that some of you could help me.

I am working with a dataset, that contains around 200 stocks. All these stocks have 20 years of monthly shareprices.

Some of these stocks are delisted (for example goes bankrupt) during the time series. The problem is, that the delisted stocks keep having the same shareprice (the last price quoted before delisted) through the whole sample period.

for example (look at stock 4):

Date	Stock1	Stock2	Stock3	Stock4 (delisted)
month1	price	price	price	87
month2	price	price	price	91
month3	price	price	price	88 (delisted)
month4	price	price	price	88
month5	price	price	price	88
month6	...	...	...	88

<tbody>
</tbody>

So stock 4 is delisted in month 3, but the same price stay in all the months after.

I want to delete the prices (leave cells blank) if the same shareprice appears 3 time in a row for a stock.
So for stock 4 i want to keep the price 88 in month 3, month 4 and month 5, but then I want to delete the price in month 6 and all months after.

Can you help me to solve this, so I dont need to do this manually?

I am able to do a little bit of VBA programming, but it is difficult for me to write a code from scratch.
Maybe it can be done without VBA?

Can any of you guide me?? Any ideas is much appreciated!

Thank you so much!

 

[JackDanIce]

Try:

Sub Macro1()


    Dim arr()   As Variant
    Dim x       As Long
    Dim y       As Long
    Dim i       As Long
    Dim bRem    As Boolean
    
    i = 1
    
    With ActiveSheet
        'Assumes header values in row 1 and month values in column A to define table size
        y = .Cells(1, .Columns.Count).End(xlToLeft).Column
        x = .Cells(.Rows.Count, 1).End(xlUp).row
                
        arr = .Cells(1, 1).Resize(x, y).Value
        
        For y = LBound(arr, 2) + 1 To UBound(arr, 2)
            bRem = False
            For x = LBound(arr, 1) + 1 To UBound(arr, 1)
                i = 1 + IIf(arr(x, y) = arr(x - 1, y), i, 0)
                bRem = i > 3 Or bRem
                If i > 3 Or bRem Then arr(x, y) = Empty
            Next x
        Next y
        
        .Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    End With
    
    Erase arr
End Sub

 

[Showroom]

Wow! Thank you so much!

It is working very good!!
I forgot to mention that some of the stocks (very few, so I could actually handle these manuallu) are listed later in the time series. So some stocks start with black cells for some months, and then a price appears. The code will at this moment see these "blank cells" (if repeated more than 3 times) as duplicates, and will remove the prices, that should appear later.

If it can be fixed by changing one line of code, you are more than welcome to help - but if it is more difficult to handle, then it doesn't matter (you have already done enough)

Thank you so much!

 

[JackDanIce]

You're welcome. Unfortunately looks like it's not just adding 1 line of code! Let's see if anyone else posts a suggestion.