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.
 

Some videos you may like

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.

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! :)
 

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Threads
1,106,413
Messages
5,511,189
Members
408,829
Latest member
sheshe123

This Week's Hot Topics

  • Turn fraction around
    Hello I need to turn a fraction around, for example I have 1/3 but I need to present as 3/1
  • TIme Clock record reformatting to ???
    Hello All, I'd like some help formatting this (Tbl-A)(Loaded via Power Query) [ATTACH type="full" width="511px" alt="PQdata.png"]22252[/ATTACH]...
  • TextBox Match
    hi, I am having a few issues with my code below, what I need it to do is when they enter a value in textbox8 (QTY) either 1,2 or 3 the 3 textboxes...
  • Using Large function based on Multiple Criteria
    Hello, I can't seem to get a Large formula to work based on two criteria's. I can easily get a oldest value based one value, but I'm struggling...
  • Can you check my code please
    Hi, Im going round in circles with a Compil Error End With Without With Here is the code [CODE=rich] Private Sub...
  • Combining 2 pivot tables into 1 chart
    Hello everyone, My question sounds simple but I do not know the answer. I have 2 pivot tables and 2 charts that go with this. However I want to...
Top