Excel Number Repositioning

Hello Experts,

I'm not even sure how to word this request.

Some of the experts that have assisted me in the past are aware that I'm embarking on a new career trading stocks and shares.

In this request whenever a change has occured in any of the cells in row 3 that change will placed in the row 4 below. When another change occurs in any of the cells in row 3 then that will replace the current values in row 4 and the those values in row 4 will now be placed in row 5 and so on.....

This is probably the most challenging request I've ever asked.

So lets say in the current value in cell b3 is 50 it then changes to 150, the old value of 50 will now be pushed into cell b4. Now, cell b3 has now changed from 150 to 275, the value of 150 will now be pushed into b4 and the old value in b4(50) will be pushed into b5. So each time the value changes in B3 everything will be pushed down one and so on ...

I really hope you guys/grls can help me out.

Cheers
Who is Participating?

Commented:
I modified the code to watch cells B25:N25 for changes. If so, a new row is inserted at row 3 and the remaining rows pushed down. If a row is pushed past row 23, it is deleted.

``````Private Sub Worksheet_Calculate()
Dim cel As Range, targ As Range
Static oldVal(14) As Double
Dim i As Long, j As Long
Dim newVal As Double
Set cel = Range("B3")
Set targ = Range("B25")

Application.EnableEvents = False
Application.ScreenUpdating = False
newVal = targ.Value
For j = 2 To 14     'Watch columns B through N on row 25 for changes
If oldVal(j) <> targ.Cells(1, j - 1) Then
'Shift entire row down
cel.EntireRow.Insert Shift:=xlShiftDown
cel.EntireRow.Copy cel.Offset(-1, 0).EntireRow
cel.EntireRow.Offset(-1, 0).Formula = targ.EntireRow.Value
For i = 2 To 14
oldVal(i) = targ.Cells(1, i - 1).Value
Next
Rows(24).Delete
Exit For
End If
Next
Application.EnableEvents = True

End Sub
``````
0

Commented:
You didn't say whether you wanted the entire line to be moved down or just cells in column B. Both options are shown in this Worksheet_Change sub (goes in code pane for worksheet).

You will also need to clarify how you want the formatting handled. The line highlighting doesn't look too good  after a few cells have been inserted.

``````Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, targ As Range
Dim oldVal As Double, newVal As Double
Set targ = Range("B3")  'Watch these cells
Set cel = Intersect(Target, targ)
If cel Is Nothing Then Exit Sub

Application.EnableEvents = False
Application.ScreenUpdating = False
newVal = cel.Value
Application.Undo
oldVal = cel.Value
If oldVal <> newVal Then
'Shift just cell B3 down
cel.Insert Shift:=xlShiftDown
cel.Offset(-1, 0).Value = newVal

'Shift entire row down
'cel.EntireRow.Insert Shift:=xlShiftDown, CopyOrigin:=cel.EntireRow
'cel.Offset(-1, 0).EntireRow.Value = cel.EntireRow.Value
'cel.Offset(-1, 0).Value = newVal
End If
Application.EnableEvents = True
End Sub
``````
0

Author Commented:
Hi byundt

Thanks for responding. I very much would like the entire line. I was just using the single cell example as an illustration.

Going to check out worksheet now...

0

Commented:
cpatte7372,
I had the code temporarily turned off by putting an "x" in front of the sub name. If it doesn't work, please remove the "x" and try again.

I have subsequently repaired the file in the Comment.

0

Commented:
cpatte7372,
If you want to push the entire line down, copy formulas and formats for the newly inserted line and retain the latest price, then try this revision to my previous code:
``````Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, targ As Range
Dim oldVal As Double, newVal As Double
Set targ = Range("B3")  'Watch these cells
Set cel = Intersect(Target, targ)
If cel Is Nothing Then Exit Sub

Application.EnableEvents = False
Application.ScreenUpdating = False
newVal = cel.Value
Application.Undo
oldVal = cel.Value
If oldVal <> newVal Then
'Shift entire row down
cel.EntireRow.Insert Shift:=xlShiftDown, CopyOrigin:=cel.EntireRow
cel.EntireRow.Copy cel.Offset(-1, 0).EntireRow
cel.Offset(-1, 0).Value = newVal
End If
Application.EnableEvents = True
End Sub
``````

0

Author Commented:
Hi byundt,

Whenever I make these request, I always forget to mention the values are dynamic. I have uploaded your attachment with a slight modification.

So lets say the values in all cells in row 3 are getting their numbers from the changes in the values in row 25. Now, if I change in value occurs in any of the cells in row 25 all values currently in row 3 will move down to row 4 and so on....

0

Author Commented:
Dude,

This is looking really good. I'm excited.... Is it possible to have the range carried over to all cells in row 3?

This is amazing........ whooooaa
0

Author Commented:
Ouch!

byundt, I think it may be problem as I do need it to be dynamic. I was playing around with the spreadsheet and I realised that if its dynamic it may be a problem to get it to work.

Is there a way around this?
0

Commented:
I changed the code to watch cell B25 and move rows 3-12 down with each change.

``````Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, targ As Range
Dim oldVal As Double, newVal As Double
Set cel = Range("B3")
Set targ = Range("B25")  'Watch these cells
Set targ = Intersect(Target, targ)
If targ Is Nothing Then Exit Sub

Application.EnableEvents = False
Application.ScreenUpdating = False
newVal = targ.Value
Application.Undo
oldVal = targ.Value
If oldVal <> newVal Then
'Shift entire row down
cel.Offset(1, 0).EntireRow.Insert Shift:=xlShiftDown, CopyOrigin:=cel.EntireRow
cel.EntireRow.Copy cel.Offset(1, 0).EntireRow
cel.EntireRow.Offset(1, 0).Formula = cel.EntireRow.Value
cel.Value = newVal
targ.Value = newVal
Rows(24).Delete
End If
Application.EnableEvents = True
End Sub
``````

I also used Conditional formatting to get the color bars highlighting every fourth row using a Formula is criteria of:
=MOD(ROW(),4)=2

0

Author Commented:
Hi byundt,

You still around, mate?
0

Commented:
It is worth noting that the Worksheet_Change sub responds to changes initiated by the user. If your values update due to external data sources, then you may need to use a different type of event sub, such as the Worksheet_Calculate sub I had suggested to you in an earlier thread.

Note: this approach requires that your worksheet have at least one cell with a volatile formula, such as =NOW(). I chose cell Q1 for this purpose.

``````Private Sub Worksheet_Calculate()
Dim cel As Range, targ As Range
Static oldVal As Double
Dim newVal As Double
Set cel = Range("B3")
Set targ = Range("B25")

Application.EnableEvents = False
Application.ScreenUpdating = False
newVal = targ.Value
If oldVal <> newVal Then
'Shift entire row down
cel.EntireRow.Insert Shift:=xlShiftDown
cel.EntireRow.Copy cel.Offset(-1, 0).EntireRow
cel.EntireRow.Offset(-1, 0).Formula = targ.EntireRow.Value
oldVal = newVal
Rows(24).Delete
End If
Application.EnableEvents = True

End Sub
``````
0

Author Commented:
byundt,

This is looking brilliant.

Couple of questions:

I understand what you mean when you say you've changed the code to watch cell B25, but not sure what you mean by 'and move rows 3-12 down with each change'?

Is it possible to change the code to watch for all cells B25 through N25?

Cheers

This is looking genius mate.
0

Author Commented:
Which I guess might mean also watching cells B3 through to N3, but not sure.

Cheers
0

Author Commented:
Hi byundt,

Would I need to change the following?

Set cel = Range("B3")
Set targ = Range("B25")
0

Author Commented:
Mate, this is absolute magic. If this works in realtime tomorrow when the stock market opens at a minimum you will have saved me over \$200/month in subscription fees alone. If I can successfully use it to trade then I a am on my way to a successful career.

There is something that I need to tweak on it. I'm just going to try it myself, but I'm sure I'll screw it up, so hopefully you'll still be online for the next 20 minutes.

0

Author Commented:
byundt,

As I thought, my modification failed. I moved the cell values from row 25 to row 3.

I changed For j = 2 To 14 For j = 17 To 29

And changed Rows(24).Delete to  Rows(1000).Delete, but it keeps on failing with subscript out of range, and it won't be the rows down....

0

Author Commented:
So byundt,

Basically I want everything to remain the same apart from where row 3 gets it numbers from - now located in cells Q3 through to AC3.

I thought I could sort it but .....
0

Author Commented:
Hi byundt,

Are you still around mate.... I'm trying to make the modifications myself but failing miserably....
0

Commented:
cpatte7372,
Try the code like this:

``````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
Set targ = Range("Q3:AC3")  'Watch these cells for changes
nCols = targ.Columns.Count
Set rg = Range("B3:N3")     'Put changed values here, pushing old values down
Set rg2 = rg.Offset(0, -1).Resize(1, nCols + 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).Formula = targ.Value
For i = 1 To nCols      'Capture values of data for next run
oldVal(i) = targ.Cells(1, i).Value
Next
Exit For
End If
Next
Application.EnableEvents = True

End Sub
``````

And please don't forget the volatile formula (see cell Q1). If you don't have one, the code won't trigger.

0

Author Commented:
Hi byundt,

Thanks for sticking around mate. Unfortunately, it doesn't work as you got it work before the change. I would very much like everything to work as before but instead of getting the values from B25:N25 its now getting its values from Q3:AC3.

The rows don't go down as before, neither will it go down if any value changes..
0

Commented:
My guess is that events were turned off and you encountered a fatal error. If so, events never got restored and the macro won't trigger.

You have three choices:
1) Restart Excel and reopen the file
2) Run the following statement in the Immediate pane
Application.EnableEvents = True
3) Run the following macro:
``````Sub Restore()
Application.EnableEvents = True
End Sub
``````

You
0

Author Commented:

I just needed to restart Excel and it worked fine.

Listen mate, I really can't thank you enough.

I'm sooooooo looking forward to trying this out tomorrow. I will close it once I've put it through its paces when the market opens.

Thanks again dude.

Cheers
0

Author Commented:

Just one last thing mate. I wanted to change then length of values from Q3:AC3 to Q3:V3, but it won't work if I make that change.

I'm really sorry to be a nuisance

Hopefully, you haven't turned you PC off.

Cheers
0

Author Commented:

For some reason, the formula only works if I click run macro or F5
0

Author Commented:

I'm sure you must be tired, may be we could pick it up tomorrow.
0

Commented:
I changed the code to watch just cells in Q3:V3. It wasn't clear, however, whether you want to copy the data from Q3:V3 or from Q3:AC3 over to B3:N3. I assumed the latter, but show a commented out statement for the former in this macro:
``````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
Set targ = Range("Q3:V3")  'Watch these cells for changes
nCols = targ.Columns.Count
Set rg = Range("B3:N3")     '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
Exit For
End If
Next
Application.EnableEvents = True

End Sub
``````
0

Author Commented:

Thats great. Going to test it now...
0

Author Commented:
Mate,

That is spot on..... yeaaaawwww.

Cheers mate.
0

Commented:
Please post back in this thread tomorrow after you test on live data. I am curious to know if it is triggered successfully.

And don't forget to put a cell somewhere in the real worksheet with the formula:
=NOW()

0

Author Commented:

I certainly will.

If it does work it will be e biggest breakthrough for a trader. I have already mentioned it to a couple of colleagues who are now making offers to me to work with them on projects. I really hope it works. So excited.
0

Author Commented:

Not sure if you're at your PC, but just wanted to say the spreadsheet is working like a dream.

I modified the spreadsheet to only push down rows B3:G3, but it still pushes down H3.

Also I removed the original conditonal formatting and added conditonal formatting in Colums D and E. Basically, if one is greater than the other then highlight but if you take a look at the cell values its highlighting even when one cell is less than the other.. Is there a reason for that? Or will it require a formula?

Cheers
EE-The-Tapev10.xlsm
0

Author Commented:
Oh, I think I know why..... the formula is pushing the colours down as well, rather than just keeping the colours as a result of the conditional formatting. Is there a way to overcome that?

Cheers
0

Author Commented:

I figured out the conditional formatting still unsure why H£ still gets pushed down....
0

Author Commented:

There appears to be delay of a second between each value being updated.... Any thoughts?
0

Author Commented:

I hope you've been having a pleasant day.

I believe the problem was with conditional format being pushed down. I tried doing a conditional format on the first row but the formula pushes the format to the second row and beyond. Is there anyway to prevent the formating being pushed down.

Cheers
0

Commented:
Will revert to this question a couple of hours from now.
0

Commented:
It looked to me like your conditional formatting was messed up. I rewrote it so the higher value in a row in coumns D and E would be green and the lower would be red. If a tie, then no conditional formatting.

I also rewrote the macro so it would fit the revised range.
``````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
Set targ = Range("Q3:V3")  'Watch these cells for changes
nCols = targ.Columns.Count
Set rg = Range("B3:G3")     'Put changed values here, pushing old values down
Set rg2 = rg    'Push formatting and formulas down in range rg2

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).PasteSpecial xlPasteValues
rg2.Copy
rg2.Offset(-1, 0).PasteSpecial xlPasteFormats
'rg.Offset(-1, 0).Resize(1, nCols).Formula = targ.Value              'Copy data from same number of columns as targ
rg.Offset(-1, 0).Formula = targ.Resize(1, rg.Columns.Count).Value   'Copy data into same number of columns as rg
For i = 1 To nCols      'Capture values of data for next run
oldVal(i) = targ.Cells(1, i).Value
Next
Exit For
End If
Next
Application.EnableEvents = True

End Sub
``````
EE-The-Tapev10Q27302334.xlsm
0

Author Commented:
Brad, you started off something really amazing here mate.

Cheers
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.