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
cpatte7372Asked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
dlmilleConnect With a Mentor Commented:
I hope so - and kudo's for sorting it out.  I was just plugging in and you thought the process through - it should have always been constructed that way with the if/then/else!  Of course, when I look at the code we were working with, earlier (see my original post), it tested for > 10, then = 10, then > 5, then = 5.  It seems your most recent post on the topic is already in this order.  Curious - I'd almost suspect you took my adds to your code and inserted it into the LATEST code you have, which you then reversed to > 10 test before > 5 test, but then, again, I could be mistaken (and don't want to appear critical at all, just sharing my observations which could be faulty).  Or, is it that you just changed the lastAlert flag from 1 to 2 in one condition, and then from 2 to 1 in the other.  I'm not sure that makes a difference, either, as the code looks for the alert flag associated with the condition.  Thus,

if test > 10 then
  if lastAlert <> 50 then
     lastAlert = 50
     call shiftdown
  end if
elseif test > 5 then
  if lastAlert <> 100 then
    lastAlert = 100
    call shiftdown
  end if
end if

Is the same - lastAlert is an identifyer, and its relative value is unimportant as long as each alert has one outcome.

Could it be that the call to ShiftDown is creating an event that is messing things up?

Its possible, as you have a worksheet_change event.  Let's rectify that by turning events off before calling shiftdown and then turning them back on...

Read further on other issues that could have caused this problem (I've had this happen to me, but ignored the conditions as they were intermittent)...

Note:  There ARE conditions that blow the value of a public variable which generally holds its last value until the worksheet is closed.  It could be with what you've got going on, that could be what's happening.  So, while it may APPEAR to be working, you could have just been running for a while without "blowing" the variable's value - e.g., the set of conditions hasn't happened as yet to do that.

Public variables - All variables dimensioned at this level are available to all Procedures in all Modules. Its value is retained unless the Workbook closes or the End Statement is used.

I would add to that that a fault termination of code could also "blow" the value of lastAlert.

If this problem persists, then we should consider storing the variable in a workbook / text file / registry / name / etc.  Regardless, I think we should both change our current practice and use these alternatives to public variables to ensure persistence of key variables in our applications.

So, here's the code rewritten, storing the variable in the worksheet - that's easy enough to deal with.  In this example, lastAlert is locally declared in the alerting subroutine, as a range, addressing the mini DOW worksheet at AX5 (you can adjust).  Now, we can eliminate the "blowing" of a persistent Public variable based on unanticipated/eventual events:
 
Public myValue
Public myCount As Long
Public myTime
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()
Dim lastAlert As Range

    Set lastAlert = ThisWorkbook.Sheets("mini sized DOW").Range("AX5") ' you can move this, anywhere
    
   DoEvents
   If ThisWorkbook.Sheets("mini sized DOW").Range("aw3") = myValue Then
      If myCount > 10 Then
        'set lastAlert = 1
        If lastAlert.Value <> 1 Then
            Application.EnableEvents = False
            Call shiftDown
            Application.EnableEvents = True
            lastAlert.Value = 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.Value <> 2 Then
            Application.EnableEvents = False
            Call shiftDown
            Application.EnableEvents = True
            lastAlert.Value = 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


Note, the call to disable/re-enable events could have been moved to the shiftdown subroutine, but I put it here just to make it all clear, one one codeset.

So.... you could hold these suggestions in your "back pocket" and see how your code works over the ensuing days before trying it out, or go for it!  :)

Let me know your thoughts and how things play out.

Dave
0
 
dlmilleCommented:
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
0
 
cpatte7372Author Commented:
Hi Dave,

Thanks for responding to this mate.

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

Thanks again mate.
0
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
cpatte7372Author Commented:
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.
0
 
cpatte7372Author Commented:
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
0
 
dlmilleCommented:
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
0
 
cpatte7372Author Commented:
Dave is D Man,

Thanks D,

Will check it out when the markets close.

0
 
cpatte7372Author Commented:
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.
0
 
cpatte7372Author Commented:
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
0
 
cpatte7372Author Commented:
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
0
 
cpatte7372Author Commented:
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
0
 
cpatte7372Author Commented:
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
0
 
cpatte7372Author Commented:
Just thinking....

Maybe the 'Call shiftdown' should come after myCount? uhmmmmmm
0
 
dlmilleCommented:
I'm on a plane across to the East Coast, today.  Will try to look at it, tonite...
0
 
cpatte7372Author Commented:
OK, mate.

I think my last suggestion fixed it.

Have a nice time.

Cheers
0
 
cpatte7372Author Commented:
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.

0
 
dlmilleCommented:
I'm in D. C.

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

Let me know.

Dave
0
 
cpatte7372Author Commented:
Thanks
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.