asked on

Excel Cell Shfit Down

Hello Experts,

An Expert called Dave assisted me with a request that I would like adjusted for the attached spreadsheet.

Basically the code from the original request shifted the values from a row down each time a cell changed from a different cells elsewhere in the spreadsheet.

This time I would like a the value in cell AW3 to shift down once an alert has occurred.

The alert has already been taken care of by another brilliant expert called akoster, so I shouldn't need help with the alert. I just need the value to shift down once the alert occurs.

The following is the code for the original shifting:

Option Explicit

Private Sub Worksheet_Calculate()
Dim rg As Range, rg2 As Range, targ As Range
Static oldVal(13) As Double
Dim i As Long, j As Long, nCols As Long
Dim lastRow As Long

Set targ = Range("Q3:T3") 'Watch these cells for changes
nCols = targ.Columns.Count

Call setConditionals 'just to ensure its initialized in the first row

Set rg = Range("B3:G3") 'Put changed values here, pushing old values down
Set rg2 = rg.Offset(0, -1).Resize(1, rg.Columns.Count + 2)

Application.EnableEvents = False
Application.ScreenUpdating = False

For j = 1 To nCols 'Watch columns Q through AC on row 3 for changes
If oldVal(j) <> targ.Cells(1, j) Then
'Shift data down
rg2.Insert Shift:=xlShiftDown
rg2.Copy rg2.Offset(-1, 0)
'rg.Offset(-1, 0).Resize(1, nCols).Formula = targ.Value 'Copy over just data in Q3:V3
rg.Offset(-1, 0).Formula = targ.Resize(1, rg.Columns.Count).Value 'Copy over data in Q3:AC3
For i = 1 To nCols 'Capture values of data for next run
oldVal(i) = targ.Cells(1, i).Value
Next i

Call setConditionals 'to update the new row 3, as its now the new row

Exit For
End If
Next j

'put the rest of this after your loop in the worksheet_calculate subroutine - or call it when you want as a separate module, to pare down your data, as needed.

lastRow = Range("A" & Rows.Count).End(xlUp).Row
lastRow = IIf(lastRow < 1200, 1200, lastRow)

Range("A2500", Range("A" & lastRow)).EntireRow.Clear

Application.EnableEvents = True

End Sub

I have attached spreadsheet that needs the additional added to it.

As always, thank you in advance.

Cheers

Carlton
EE-TRADING.xlsm

dlmille

Here's what happens when the alert is flagged:
Private Sub Worksheet_Calculate()
Dim cel As Range
Dim Addr As Variant, targ As Variant
Static Stocks(3) As Double 'Starts with element 0
Dim i As Long, n As Long

'Added code
If ActiveSheet.Range("AQ3").Value >= 288 Or ActiveSheet.Range("AV3").Value >= 288 Then
Call soundAlert(True)
Call shiftDown
Else
Call soundAlert(False)
End If

The call to shiftDown is made if the alert is valid. I created a subroutine called "shiftDown()" using your code, and some modification, above, and put it in module 2.

Here's that code:

Sub shiftDown()
Dim rg As Range, rg2 As Range, targ As Range
Static oldVal(13) As Double
Dim i As Long, j As Long, nCols As Long
Dim lastRow As Long

    Set rg = Range("AW3")
    Set rg2 = rg.Offset(1, 0)
    
    rg2.Insert shift:=xlShiftDown, copyorigin:=1
    
    rg2.Value = rg.Value
            
    Range("AW1201").Clear 'will delete when data finally gets here

End Sub

Open in new window

It skips a line then starts dumping the output - to row 1200 max.

See attached,

Cheers,

Dave

EE-TRADING-r1.xlsm

cpatte7372

ASKER

Hi Dave,

Thanks for responding to this mate.

I will check it out as soon as the markets are closed...

Thanks again mate.

cpatte7372

ASKER

Hi Dave,

I put the Call shiftdown when the timer alert appeared (as shown) and it worked fine.

Thanks again buddy.

Sub StartTimer()
DoEvents
If ThisWorkbook.Sheets("mini sized DOW").Range("aw3") = myValue Then
If myCount > 10 Then
Call shiftDown
DoEvents
ElseIf myCount = 10 Then
'-- green highlite when over 10 seconds
ThisWorkbook.Sheets("mini sized DOW").Range("aw3").Interior.ColorIndex = 4
Open "C:\Users\User\Documents\ABC.txt" For Append As #1 'Change path & name to suit
Write #1, Format(Now, "dd-mm-yyyy hh:MM:ss.ss") & " Highlight 10 seconds, value =" & ThisWorkbook.Sheets("mini sized DOW").Range("aw3")
Close 1
ElseIf myCount > 5 Then
Call shiftDown
DoEvents
ElseIf myCount = 5 Then
'-- yellow highlite when over 15 seconds
ThisWorkbook.Sheets("mini sized DOW").Range("aw3").Interior.ColorIndex = 6
Open "C:\Users\User\Documents\ABC.txt" For Append As #1 'Change path & name to suit
Write #1, Format(Now, "dd-mm-yyyy hh:MM:ss.ss") & " Highlight 5 seconds, value =" & ThisWorkbook.Sheets("mini sized DOW").Range("aw3")
Close 1
End If
myCount = myCount + 1
Else
myCount = 1
ThisWorkbook.Sheets("mini sized DOW").Range("aw3").Interior.ColorIndex = xlNone
myValue = ThisWorkbook.Sheets("mini sized DOW").Range("aw3")
End If
myTime = Now + TimeValue("00:00:01")
Application.OnTime myTime, "StartTimer"
End Sub

Cheers mate.

cpatte7372

ASKER

Dave,

Just one last request, is it possible to have the Call shiftdown only be activated once per alert and then reactivated when another alert appears?

Cheers

dlmille

Declare a public variable, called lastAlert, which should sustain its value while the workbook is open, then test for lastAlert before shiftDown, as follows:

Public myValue
Public myCount As Long
Public myTime
Public lastAlert As Long
Public Sub nvi()
   Sheets("mini sized DOW").Range("T3:T35").Value = Sheets("mini sized DOW").Range("S3:S35").Value
   Application.OnTime CVDate((Int(Now * 30 * 24) + 1) / 24 / 30), "nvi"
End Sub
Public Sub pvt()
   Sheets("mini sized DOW").Range("V3:V35").Value = Sheets("mini sized DOW").Range("U3:U35").Value
   Application.OnTime CVDate((Int(Now * 30 * 24) + 1) / 24 / 30), "pvt"
End Sub
Public Sub crs()
   Sheets("mini sized DOW").Range("X3:X35").Value = Sheets("mini sized DOW").Range("W3:W35").Value
   Application.OnTime CVDate((Int(Now * 30 * 24) + 1) / 24 / 30), "crs"
End Sub
Public Sub obv()
   Sheets("mini sized DOW").Range("Z3:Z35").Value = Sheets("mini sized DOW").Range("Y3:Y35").Value
   Application.OnTime CVDate((Int(Now * 30 * 24) + 1) / 24 / 30), "obv"
End Sub
Sub StartTimer()
   DoEvents
   If ThisWorkbook.Sheets("mini sized DOW").Range("aw3") = myValue Then
      If myCount > 10 Then
        'set lastAlert = 1
        If lastAlert <> 1 Then
            Call shiftDown
            lastAlert = 1
        End If
            DoEvents
      ElseIf myCount = 10 Then
            '-- green highlite when over 10 seconds
            ThisWorkbook.Sheets("mini sized DOW").Range("aw3").Interior.ColorIndex = 4
            Open "C:\Users\User\Documents\ABC.txt" For Append As #1  'Change path & name to suit
            Write #1, Format(Now, "dd-mm-yyyy hh:MM:ss.ss") & " Highlight 10 seconds, value =" & ThisWorkbook.Sheets("mini sized DOW").Range("aw3")
            Close 1
      ElseIf myCount > 5 Then
        'set lastAlert = 2
        If lastAlert <> 2 Then
            Call shiftDown
            lastAlert = 2
        End If
              DoEvents
      ElseIf myCount = 5 Then
            '-- yellow highlite when over 15 seconds
            ThisWorkbook.Sheets("mini sized DOW").Range("aw3").Interior.ColorIndex = 6
            Open "C:\Users\User\Documents\ABC.txt" For Append As #1  'Change path & name to suit
            Write #1, Format(Now, "dd-mm-yyyy hh:MM:ss.ss") & " Highlight 5 seconds, value =" & ThisWorkbook.Sheets("mini sized DOW").Range("aw3")
            Close 1
      End If
      myCount = myCount + 1
   Else
      myCount = 1
      ThisWorkbook.Sheets("mini sized DOW").Range("aw3").Interior.ColorIndex = xlNone
      myValue = ThisWorkbook.Sheets("mini sized DOW").Range("aw3")
   End If
   myTime = Now + TimeValue("00:00:01")
   Application.OnTime myTime, "StartTimer"
End Sub

Sub StopTimer()
   Application.OnTime _
      EarliestTime:=myTime, _
      Procedure:="StartTimer", _
      Schedule:=False
End Sub

Open in new window

Dave

cpatte7372

ASKER

Dave is D Man,

Thanks D,

Will check it out when the markets close.

cpatte7372

ASKER

Hi Dave,

Hope all is well.

I've been reviewing the new code and unfortunately it appears to work intermittently. Its quite hard to describe. It will shift down for the first timer alert but when another alert appear after it won't shift down.

For the time being I shall stick with your original 'Shiftdown' code to trade the markets. However, when you have a spare moment it would be great if you give the new code a once over.

Cheers mate.

cpatte7372

ASKER

Dave,

I think the issue may lie with the following:

Sub StartTimer()
DoEvents
If ThisWorkbook.Sheets("mini sized DOW").Range("aw3") = myValue Then
If myCount > 10 Then
'set lastAlert = 1
If lastAlert <> 1 Then
Call shiftDown
lastAlert = 1
End If
DoEvents
ElseIf myCount = 10 Then
'-- green highlite when over 10 seconds
ThisWorkbook.Sheets("mini sized DOW").Range("aw3").Interior.ColorIndex = 4
Open "C:\Users\User\Documents\ABC.txt" For Append As #1 'Change path & name to suit
Write #1, Format(Now, "dd-mm-yyyy hh:MM:ss.ss") & " Highlight 10 seconds, value =" & ThisWorkbook.Sheets("mini sized DOW").Range("aw3")
Close 1
ElseIf myCount > 5 Then
'set lastAlert = 2
If lastAlert <> 2 Then
Call shiftDown
lastAlert = 2

Cheers

cpatte7372

ASKER

D,

Just checked it out again and it definitely works once and then stops.

Just a side note, but I noticed that the spreadsheet kept on calling another spreadsheet called DowTradingUpdate.xlsm. I changed the name of the spreadsheet from DowTradingUpdate.xlsm to EE-DAVE.xlsm, and while running the latter spreadsheet it kept on bringing up DowTradingUpdate.xlsm.

I don't think it means much, but I thought I would let you know.

Cheers

cpatte7372

ASKER

Hi Dave,

I think I may have figured it out.

I change the numbers around like this

If myCount > 10 Then
'set lastAlert = 2
If lastAlert <> 2 Then
Call shiftDown
lastAlert = 2
End If

and

ElseIf myCount > 5 Then
'set lastAlert = 1
If lastAlert <> 1 Then
Call shiftDown
lastAlert = 1

I think that may have fixed the problem because 5 will come before 10....

Testing it now...

Cheers

cpatte7372

ASKER

Hello Dave,

After carrying out tests following the modifications I thought would resolve the issue the formula is still missing shiftsdown.

The highlights that akoster helped me with are working perfectly with the timer. I might play around with it a bit more, but when you get a free slot I wonder if you could take a look at it mate.

The original shiftdown seems to work fine, but as you know it keeps on shifting down

Cheers

cpatte7372

ASKER

Just thinking....

Maybe the 'Call shiftdown' should come after myCount? uhmmmmmm

dlmille

I'm on a plane across to the East Coast, today. Will try to look at it, tonite...

cpatte7372

ASKER

OK, mate.

I think my last suggestion fixed it.

Have a nice time.

Cheers

ASKER CERTIFIED SOLUTION

dlmille

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

cpatte7372

ASKER

Hi Dave,

Glad to hear you're having a nice time. Where in the East Coast are you?

Anyway, you were correct - I did take the add and insert them into latest code.

Since I moving the Call shiftdown' after myCount? It hasn't failed once.

I think I've learned more about VBA in our recent posts than I've learned from VBA for Dummies.

Cheers mate.

Enjoy your time in the East Coast.

dlmille

I'm in D. C.

Dave

dlmille

Carlton - is this question resolved? Just going back through stuff and found it open.

Let me know.

Dave

cpatte7372

ASKER

Thanks