Start Free Trial

asked on

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 attached the spreadsheet.

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

Cheers
EE-BID-ASK.xlsm

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

Open in new window

EE-BID-ASKQ27302334.xlsm

ASKER

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

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.

Brad

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

Open in new window

Brad
EE-BID-ASKQ27302334.xlsm

ASKER

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

EE-BID-ASKQ27302334Update.xlsm

ASKER

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

ASKER

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?

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

Open in new window

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

Brad
EE-BID-ASKQ27302334Update.xlsm

ASKER

Hi byundt,

You still around, mate?

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

Open in new window

EE-BID-ASKQ27302334UpdateALT.xlsm

ASKER

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.

ASKER

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

Cheers

ASKER

Hi byundt,

Would I need to change the following?

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

ASKER CERTIFIED SOLUTION

membership

This solution is only available to members.

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

Start Free Trial

ASKER

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.

ASKER

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

Please see attached.
EE-BID-ASKV3.xlsm

ASKER

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

ASKER

Hi byundt,

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

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

Open in new window

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

Brad
EE-BID-ASKV3Q27302334.xlsm

ASKER

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

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

Open in new window

You

ASKER

Brad,

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

ASKER

Brad,

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

ASKER

Brad,

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

ASKER

Brad,

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

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

Open in new window

EE-BID-ASKV3Q27302334.xlsm

ASKER

Hi Brad,

Thats great. Going to test it now...

ASKER

Mate,

That is spot on..... yeaaaawwww.

Cheers mate.

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()

Brad

ASKER

Brad

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.

ASKER

Hi Brad,

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

ASKER

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

ASKER

Hi Brad,

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

ASKER

Hi Brad,

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

ASKER

Hi Brad,

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

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

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

Open in new window

EE-The-Tapev10Q27302334.xlsm

ASKER

Brad, you started off something really amazing here mate.

Cheers