Shift cell group depending on date entered

JohnMurphy

New Member
Joined
Jul 28, 2010
Messages
8
I’m trying to develop a macro for a spreadsheet I’m working on. What I’m trying to do is have a group of cells shift left or right according to the date that is entered to the far left.

For example, if 01/01/10 is entered, the macro would shift the cell group of that row so they begin at the january column. The cell in the group should all remain adjacent to one another.

Please let me know if there is anything else you need for help, such as a screenshot or an upload. I am also looking to see if excel can optimize the position of the cell group on its own, to minimize monthly costs, but I can put that in a separate thread, if need be.

Thank you.
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Hi, Try this:-
The code assumes you have in row (1) the Months January to December (As text, but does not matter in which column they start) and the dates are in column "A" with Row data offset in columns various.
Code:
[COLOR=navy]Sub[/COLOR] MG28Jul16
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Temp [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] DnColRng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Ac [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] ColRng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Set[/COLOR] ColRng = Range(Range("A1"), Cells(1, Columns.Count).End(xlToLeft))
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]Set[/COLOR] DnColRng = Range(Range("A" & Dn.Row), Cells(Dn.Row, Columns.Count).End(xlToLeft))
        Temp = DnColRng
            [COLOR=navy]If[/COLOR] IsDate(Dn) [COLOR=navy]Then[/COLOR]
                [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Ac [COLOR=navy]In[/COLOR] ColRng
                    DoEvents
                    [COLOR=navy]If[/COLOR] Ac <> "" And Month(Day(Dn) & " " & Ac & " " & Year(Dn)) = Month(Dn) [COLOR=navy]Then[/COLOR]
                         Temp(1, 1) = Format(Temp(1, 1), "dd/mm/yy")
                         Dn.EntireRow.ClearContents
                         Dn(, Ac.Column).Resize(, DnColRng.Count) = Temp                          [COLOR=navy]Exit[/COLOR] For
                    [COLOR=navy]End[/COLOR] If
                [COLOR=navy]Next[/COLOR] Ac
            [COLOR=navy]End[/COLOR] If
  [COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:

JohnMurphy

New Member
Joined
Jul 28, 2010
Messages
8
Mick, I can't thank you enough for your help. Did you find it difficult, or is this second nature for you? :)

I'm having a bit of difficulty running the macro. It is on the line with "Exit For," I believe (since it is red lettering). It's a syntax error. I tried some little tweaks, but don't know enough to see what's wrong. I put "Exit For" on the next line and the error changed to "Runtime error '13.' Type Mismatch."
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841

ADVERTISEMENT

Hi, I've looked at your sheet, and its obvious what I given you is not quite what you want.
If you could explain what you want to achieve based on your sheet ,i.e Which bit is before and which bit is after !!!. I'll try to alter the code.
Regards Mick
 

JohnMurphy

New Member
Joined
Jul 28, 2010
Messages
8
Yeah, after I posted the image, i realize i should've clarified. Despite the fact that there are two tables involved (Remaining Capital and Cash Out), I really only need the code for the top one since there is not much flexibility with the bottom one.

Further down the road, I'd also like to have excel auto-optimize the spacing of the ranges to maximize Net Monthly Cash (which is merely the net sum of the previous month's Remaining Capital and Cash Out, but I don't know if that is beyond the scope of this forum or excel's powers.

Again Mick, cheers for helping. Where did you learn your excel prowess? I'm something of a computer nerd, but not when it comes to languages.
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841

ADVERTISEMENT

Hi, John
Unless I'm missing something the Data Set "Remaining Capital" seems to show the result I would expect to see when the code Has run. If that is the case, what did the Data look like before Running the code.

Any knowledge I have for writing code is down to Half a dozen books, learning from other contributors, Practicing on Sites like this, and the Macro recorder.
Regards Mick
 

JohnMurphy

New Member
Joined
Jul 28, 2010
Messages
8
You're correct. That is what it should look like after the macro runs. Beforehand, the ranges would be scattered to the left of right of the new starting date. I'll be making constant changes to the start dates of projects and expansions to the table in the coming years and wanted to find a good solution from the get-go.
 
Last edited:

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Hi, Based on the format for Data set "Remaining Capital" as in your sheet, this should giove you a result.
NB:- The Code will Start in "B5" and stop when it gets to a Blank cell in column "B", also, It will not alter the Total Row Data, because the data above it will not be in the same position after the code has run. !!

Code:
[COLOR="Navy"]Sub[/COLOR] MG29Jul28
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Temp [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] DnColRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] ColRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] ColRng = Range(Range("C4"), Cells(4, Columns.Count).End(xlToLeft))
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B5"), Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
  [COLOR="Navy"]If[/COLOR] Dn = vbNullString [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
    [COLOR="Navy"]Set[/COLOR] DnColRng = Range(Range("C" & Dn.Row), Cells(Dn.Row, Columns.Count).End(xlToLeft))
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Ac [COLOR="Navy"]In[/COLOR] DnColRng
        [COLOR="Navy"]If[/COLOR] Not Ac = vbNullString [COLOR="Navy"]Then[/COLOR] Temp = Ac.Resize(, 20): [COLOR="Navy"]Exit[/COLOR] For
        [COLOR="Navy"]Next[/COLOR] Ac
        [COLOR="Navy"]If[/COLOR] IsDate(Dn) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Ac [COLOR="Navy"]In[/COLOR] ColRng
                    DoEvents
                     [COLOR="Navy"]If[/COLOR] Ac <> "" And Month("1 " & Ac & " " & Year(Dn)) = Month(Dn) [COLOR="Navy"]Then[/COLOR]
                         Dn.Offset(, 1).Resize(, 50).ClearContents
                         Dn(, Ac.Column - 1).Resize(, DnColRng.Count) = Temp '[COLOR="Green"][B]DnColRng.Value[/B][/COLOR]
                         [COLOR="Navy"]Exit[/COLOR] For
                    [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]Next[/COLOR] Ac
            [COLOR="Navy"]End[/COLOR] If
  [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

JohnMurphy

New Member
Joined
Jul 28, 2010
Messages
8
Mick, that's great! There should be enough here to tweak it myself for years to come. Thanks again for everything you've done! :)
 

Watch MrExcel Video

Forum statistics

Threads
1,132,994
Messages
5,656,286
Members
418,292
Latest member
spd87

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top