Mariam Shabou
Mariam Shabou

Reputation: 9

How to navigate between months using icons (shapes) in excel VBA?

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

Answers (2)

Алексей Р
Алексей Р

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

enter image description here

Upvotes: 1

FaneDuru
FaneDuru

Reputation: 42236

Please, try the next way:

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

  2. 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
  1. Please, assign the two above (eloquently named). "PreviousMonth" to the left one and "NextMonth" to the right triangle. You can do it right clicking on the shape, choose 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

Related Questions