Reputation: 9
I've created several tables in the same sheet, each table assigning it to a month, plus there are two icons (two shapes) to navigate to the next or previous month. What I need is to cycle through the months using the two icons (next/previous month). For example, if the user needs January, the columns (B:AD) will be shown and the reset will be hidden, so on with the other months.
Columns to be shown: January (B:AD) February(AF:BH) March(BJ:CL) April(CN:DP) May(DR:ET) June(EV:FX) July(FZ:HB) August(HD:IF) September(IH:JJ) October(JL:KN) November(KP:LR) December(LT:MV)
Here is the link to my excel: https://1drv.ms/x/s!Av2jQlwHZCT3gjeo3q_Po99tvoSr?e=vICkeT
Upvotes: 0
Views: 249
Reputation: 7627
Try this code:
Sub go_right() 'assign to the right triangle
ShiftMonth 1
End Sub
Sub go_left() 'assign to the left triangle
ShiftMonth -1
End Sub
Sub ShiftMonth(direction As Integer)
Const PERIOD = 30 'the number of columns for each month
Const TEXT_BOX_NAME = "TextBox 1" 'your textbox (with month) name
With ThisWorkbook.Worksheets("MER Monthly Tracker")
cur = Val(.Range("A1").ID) '.Range("A1").ID uses to store the current month number (0..11)
cur = Evaluate("MOD(" & cur + direction & "," & 12 & ")") ' get the target month number according to direction
.Range("A1").ID = cur 'store the new month number
Application.ScreenUpdating = False
.Columns(2).Resize(, 12 * PERIOD).Hidden = True 'hide all columns
.Columns(2 + cur * PERIOD).Resize(, PERIOD).Hidden = False 'show columns with target month
.Shapes(TEXT_BOX_NAME).TextFrame2.TextRange.Text = .Cells(3, 2 + cur * PERIOD + 2) ' set the name of month
Application.ScreenUpdating = True
End With
End Sub
Note that triangles and TextBox should have the "Do not move or resize with cells" property, so that these shapes will not be hidden when hiding columns
Upvotes: 1
Reputation: 42236
Please, try the next way:
Your shape moving left should be named "Isosceles Triangle 1", the one moving right "Isosceles Triangle 2", as they are. The rectangle should be named "MonthsRect"! Of course, you must choose the "Do not move or resize with cells" shapes property. Right click -> Size and properties -> Properties (from 'Size & properties' part...).
Please, copy the next code in a standard module:
Option Explicit
Dim sh As Worksheet, arrMonths, shMnth As Shape
Private Const strMonths = "January,February,March,April,May,June,July,August,September,Octomber,November,December"
Private Const strCols = "B:AD,AF:BH,BJ:CL,CN:DP,DR:ET,EV:FX,FZ:HB,HD:IF,IH:JJ,JL:KN,KP:LR,LT:MV"
Sub PreviousMonth()
MoveMonths "prev"
End Sub
Sub NextMonth()
MoveMonths "next"
End Sub
Function MoveMonths(dir As String)
Dim existM As String, NextM As String, mtch, arrCol
existM = actualMonths
mtch = Application.match(existM, arrMonths, 0)
If mtch = 1 And dir = "prev" Then
NextM = "December"
ElseIf mtch = 12 And dir = "next" Then
NextM = "January"
Else
NextM = Application.Index(arrMonths, mtch + IIf(dir = "prev", -1, 1))
End If
shMnth.TextFrame2.TextRange.Text = NextM & ", 2021"
'hide columns:
sh.Range("A1:MV1").EntireColumn.Hidden = True
mtch = Application.match(NextM, arrMonths, 0)
arrCol = Split(strCols, ",")
sh.Range(arrCol(mtch - 1)).EntireColumn.Hidden = False
Application.Goto sh.Range("A1")
End Function
Function actualMonths() As String
Dim actMonth As String
If Not IsArray(arrMonths) Then
arrMonths = Split(strMonths, ",")
End If
If sh Is Nothing Then Set sh = ActiveSheet
If shMnth Is Nothing Then Set shMnth = sh.Shapes("MonthsRect")
actualMonths = Split(shMnth.TextFrame2.TextRange.Text, ",")(0)
End Function
Assign Macro...
, choose 'This workbook' at 'Macros in:', click on the appropriate Sub and press 'OK.You did not answer my clarification question regarding what to be happening when the active month is "January" and press left triangle, or "December" and press the right one. The above code will jump to "December" for the first case and to "January" in the second one. Theoretically, you could decrease the year and bring data from another sheet...
Please, play with the two triangles and send some feedback
Upvotes: 1