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
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
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
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
Related
I have an Excel sheet that's a process checklist. The background is there are 3 Combo Boxes (form control) and within each Combo Box there's multiple options the user can select. Based on what the user selects as a combination between the 3 Combo Boxes it will hide/unhide specific rows in a section and their corresponding checkboxes. I'm trying to code this in VBA.
Between setting everything up these are the problems I'm running into with VBA:
There are 60 different ways the user can select options between the 3 Combo Boxes. Including the "Select Option" options (which will be used), the first ComboBox has 5 options, the second 4 options, and the last 3 options. The obvious I've been trying is If/Else logic, but copying and pasting 60 times over seems very redundant and leaves the sheet prone to coding errors that will take time to fix. Is there a better way to code this? Or in the way I'm trying to do this for each change, the If/Else logic is the best way?
When coding (I've pasted a short example of part of my code below this section with a few of the cases), I run into "Method and data member not found" or "Invalid use of Me" errors when debugging. How do I fix this?
How do I hide and unhide the checkboxes along with the rows be hid and unhidden so the formatting doesn't change and there are not stray checkboxes everywhere?
Sub ComboBox1_Change()
'Combo Box 1 is Asset Type, Combo Box 2 is AUS, Combo Box 3 is Transaction Type
'Select, Select, Select OR Refinance
If Me.ComboBox1.Value = "Select Asset Type" And Me.ComboBox2.Value = "Select AUS" And Me.ComboBox3.Value = "Select Transaction Type" Or Me.ComboBox3.Value = "Refinance" Then
Worksheets("Assets Checklist").Rows("19:37" And "39").EntireRow.Hidden = True
'Select, Select, Purchase
ElseIf Me.ComboBox1.Value = "Select Asset Type" And Me.ComboBox2.Value = "Select AUS" And Me.ComboBox3.Value = "Purchase" Then
Worksheets("Assets Checklist").Rows("39").EntireRow.Hidden = False
Worksheets("Assets Checklist").Rows("19:37").EntireRow.Hidden = True
'Liquid, Select, Select
ElseIf Me.ComboBox1.Value = "Liquid" And Me.ComboBox2.Value = "Select AUS" And Me.ComboBox3.Value = "Select Transaction Type" Then
Worksheets("Assets Checklist").Rows("31:34").EntireRow.Hidden = False
Worksheets("Assets Checklist").Rows("19:30" And "35:37" And "39").EntireRow.Hidden = True
And the above code continues for each case.
If you have 60 distinct cases then the most maintainable method might be to use a worksheet with columns for CB1/2/3 values and a column to hold visible and hidden rows (as range address like "A1:A10,A12"). Create a method which reads the values and looks up the matching row on the sheet, then sets the row visibility accordingly.
'this is called from each of the 3 combos
Sub ShowHideRows()
Dim cb1, cb2, cb3, arr, r As Long, rngHide As String, rngShow As String
cb1 = comboValue("combo1")
cb2 = comboValue("combo2")
cb3 = comboValue("combo3")
Debug.Print cb1, cb2, cb3
arr = Me.Range("choices").Value 'lookup table is a named range
'better on a different sheet....
For r = 1 To UBound(arr, 1)
If arr(r, 1) = cb1 Then
If arr(r, 2) = cb2 Then
If arr(r, 3) = cb3 Then
rngShow = arr(r, 4)
rngHide = arr(r, 5)
Exit For 'stop checking
End If
End If
End If
Next r
If rngHide <> "" Then Me.Range(rngHide).EntireRow.Hidden = True
If rngShow <> "" Then Me.Range(rngShow).EntireRow.Hidden = False
End Sub
'read a Forms combo control value
Function comboValue(cbName As String)
With Me.Shapes(cbName)
comboValue = .ControlFormat.List(.ControlFormat.ListIndex)
End With
End Function
Setup:
'Each of the three Combo Boxes have al Linked Cell
'In an another cell concatenate the numeric values of the three Linced Cells
'e.g. in cell A1 have this: =A2 & A3 & A4
'where A2, A3, and A4 are the Linked cells of CBox1, CBox2 and CBox3
'In every ComboBox value change, call the Sub
'SixtyCases with parameter the value of cell A1
Private Sub SixtyCases(combination As String)
Select Case combination
Case "111" 'first combination
'YOUR CODE HERE
Case "112", "132" ' OR
'YOUR CODE HERE
Case "113"
'YOUR CODE HERE
'...
'...
Case "543" 'last combination
'YOUR CODE HERE
End Select
End Sub
Is there to a way to improve the below? I would like to know if an array-like statement can replace the below.
I just want to like remove the multiple "And Not"s so if you can suggest something to optimize the below then I would appreciate it.
Set ws_raw = ThisWorkbook.Worksheets("Raw")
Set ws_master_tracker = ThisWorkbook.Worksheets("Master Tracker")
' more assignments here...
For Each ws In ThisWorkbook.Worksheets
If Not ws Is ws_raw _
And Not ws Is ws_master_tracker _
And Not ws Is ws_title_page _
And Not ws Is ws_sample _
And Not ws Is ws_closing _
And Not ws Is ws_ref _
And Not ws Is ws_pdf_template _
And Not ws.Visible = xlSheetHidden Then
project_name = ws.Range("E3").Value
int_last_row_of_ws = 46
For int_current_row_of_ws = 11 To int_last_row_of_ws
cell_value = ws.Cells(int_current_row_of_ws, 3).Value
With rng_raw
.AutoFilter 1, project_name
End With
Set rng_filtered_raw = ws_raw.Range("J3", ws_raw.Cells(int_last_row_of_raw, int_last_col_of_raw)).SpecialCells(xlCellTypeVisible)
Select Case cell_value
Case Is = "Task Creation!"
module_to_look_for = "Task Creation"
' twenty more cases
' Others that are manually typed
Case Else
module_to_look_for = "MANUAL"
End Select
If Not rng_filtered_raw Is Nothing Then
If module_to_look_for = "MANUAL" Then
' Do nothing
' Highlight cell, etc.
Else
look_up_result = Application.WorksheetFunction.VLookup(module_to_look_for, rng_filtered_raw, 3, False)
If look_up_result = "" Then
ws.Cells(int_current_row_of_ws, 56).Value = "Blank Date!"
Else
ws.Cells(int_current_row_of_ws, 56).Value = look_up_result
End If
End If
End If
Next int_current_row_of_ws
End If
Next ws
Something like:
Dim some_array_variable As Array
Set some_array_variable = (ws_master_tracker, ws_title_page, .....)
If Not ws Is In some_array_variable Then
' some code...
Please help, I am new in VBA.
It depends on the type of variable you are using. This tests for primary colors:
Sub MultiAND()
kolor = "mauve"
If Not kolor = "red" And Not kolor = "blue" And Not kolor = "yellow" Then
MsgBox "secondary"
Else
MsgBox "primary"
End If
End Sub
because the variables are strings, the chain of AND NOT can be replaced by:
Sub StringMeAlong()
kolor = " mauve "
s = " red blue yellow "
If InStr(s, kolor) = 0 Then
MsgBox "secondary"
Else
MsgBox "primary"
End If
End Sub
Here is a simple prime number test for numbers less than 100:
Sub IsItPrime()
s = "|1|2|3|5|7|11|13|17|19|23|29|31|37|41|43|47|53|59|61|67|71|73|79|83|89|97|"
N = 23
v = "|" & CStr(N) & "|"
If InStr(s, v) = 0 Then
MsgBox "not prime"
Else
MsgBox "Prime"
End If
End Sub
If this was in a worksheet formula, you could use the MATCH() function with array constants.
You could use the filter method of an array to check existance:
dim arrSheets() as string
arrSheets = Split("sheetNameOne,sheetNameTwo,sheetNameThree", ",")
if ubound(filter(arrsheets,"sheetNameOne"))>-1 then debug.print "Sheet is in list"
Edit: extended answer as requested...
I used sheet names for brevity rather than worksheet objects as you just have to list the worksheet names in a comma separated string. To use the actual objects as you have done in your code you'd need to assign them to an array like so;
Dim arrSheets(3) as string
arrSheets(0) = ws_master_tracker.name
arrSheets(1) = ws_title_page.name
arrSheets(2) = ws_sample.name
Rather than as a string;
arrSheets = Split("Master Tracker,Title Page,Sample Sheet", ",")
The Split method takes a string and splits it into the elements of an array based on a delimiter, in the above example a comma. Think of Text-To-Columns in Excel.
The Ubound property describes how many elements are in an array - three in this example. It is zero based i.e. 1 instance will return 0, 2 instances = 1, 3 = 2 and so on.
The Filter method returns a new array containing only the elements that match the specified criteria, in this case a specific worksheet name. As Tim Williams commented the method will include substrings, so if you have a sheet called 'my sheet' and one called 'some other sheet' filtering for the word 'sheet' will return both.
Putting them together: Split creates the array from the string, filtering returns an array containing the string(s) requested, Ubound tells you how many times that string is in the filtered array. If its not present Ubound will return -1, otherwise a number greater than -1.
In your original code this will tell you if a sheet name is one of the names you want to omit. You'd then need to check if that sheet is hidden separately.
if ubound(filter(arrsheets,"sheetNameOne"))=-1 then ' the sheet is not in the list
if sheets("sheetNameOne").Visible = xlSheetHidden Then ' is it hidden?
I will admit to being a terrible at code, and have always struggled with Macros... forgive my ignorance.
What I am working on building is a part number index that will create a new sequential number within a numerical series after a macro-button is pressed.
I'd like each button to scan between a range [i.e. 11-0000 (MIN) and 11-9999 (MAX)] and select the max value cell that exists. At that selection point insert an entire new row below with the next + 1 sequential number in the "B" column.
I have my button creating the table row as I would like, however I need help in defining the ".select(=Max(B:B))" and as I understand Max will also limit the # of line items it queries?
I have also been playing with .Range("B" & Rows.CountLarge) with little to no success.
Ideally the 11-**** button [as seen in the screen cap] should insert a sequential number below the highlighted row.
Maybe I'm way over my head, but any guidance even in approach or fundamental structure of the code would help be greatly appreciated!
Private Sub CommandButton1_Click()
Sheets("ENGINEERING-PART NUMBERS").Range("B" & Rows.CountLarge).End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireRow.Insert Shift:=xlDown
ActiveCell.Value = "=ActiveCell + 1"
End Sub
Screen Cap of Spread Sheet
Perhaps there is a simpler solution that I've overlooked, but the below will work.
Insert a module into your workbook and add this code:
Public Sub AddNextPartNumber(ByVal FirstCellInColumn As Range, Optional ByVal PartMask As Variant = "")
Dim Temp As Variant, x As Long, MaxValueFound(1 To 2) As Variant
'Some error checking
If PartMask = "" Then
MsgBox "No part mask supplied", vbCritical
Exit Sub
ElseIf Not PartMask Like "*[#]" Then
MsgBox "Invalid part mask supplied; must end in ""#"".", vbCritical
Exit Sub
ElseIf PartMask Like "*[#]*[!#]*[#]" Then
MsgBox "Invalid part mask supplied; ""#"" must be continuous only.", vbCritical
Exit Sub
End If
'Get the column of data into an array
With FirstCellInColumn.Parent
Temp = .Range(FirstCellInColumn, .Cells(.Rows.Count, FirstCellInColumn.Column).End(xlUp))
End With
'Search through the array and find the largest matching value
For x = 1 To UBound(Temp, 1)
If Temp(x, 1) Like PartMask Then
If MaxValueFound(1) < Temp(x, 1) Then
MaxValueFound(1) = Temp(x, 1)
MaxValueFound(2) = x
End If
End If
Next x
'Output new part number
If MaxValueFound(2) = 0 Then
'This part mask doesn't exist, enter one with 0's at the end of the list
With FirstCellInColumn.Offset(x - 1, 0)
.Value = Replace(PartMask, "#", 0)
.Select
End With
Else
'Get the length of the number to output
Dim NumberMask As String, NumFormatLength As Long
NumFormatLength = Len(PartMask) - Len(Replace(PartMask, "#", ""))
NumberMask = String(NumFormatLength, "#")
'Determine the new part number
MaxValueFound(1) = Replace(MaxValueFound(1), Replace(PartMask, NumberMask, ""), "")
MaxValueFound(1) = Replace(PartMask, NumberMask, "") & Format((MaxValueFound(1) * 1) + 1, String(NumFormatLength, "0"))
'Insert row, add new part number and select new cell
FirstCellInColumn.Offset(MaxValueFound(2), 0).EntireRow.Insert
With FirstCellInColumn.Offset(MaxValueFound(2), 0)
.Value = MaxValueFound(1)
.Select
End With
End If
End Sub
Then, for each button, you write the code like this:
Private Sub CommandButton1_Click()
'this is the code for the [ADD 11-****] button
AddNextPartNumber Me.Range("B16"), "11-####"
End Sub
Private Sub CommandButton2_Click()
'this is the code for the [ADD 22-****] button
AddNextPartNumber Me.Range("B16"), "22-####"
End Sub
This has been written assuming that inserting a new row onto your sheet won't affect other data and that adding new data to the bottom of the table without inserting a row also won't affect other data.
Assuming you're working with a table, by default it should auto-resize to include new data added to the last row.
Good luck learning the ropes. Hopefully my comments help you understand how what I wrote works.
I have 80 rows where the user can enter a predetermined value under column Ward. This unhides a button next to it. Upon clicking it, it empties the adjacent value and increments (+1) a particular cell in another sheet depending on the original value.
Currently, I have 80 ActiveX buttons next to the Ward cells that hides/unhides depending on the value of the Ward cells. I've noticed that adding more buttons slows down the spreadsheet because of the sheer volume of If Then statements I have.
If Range("F8").Value = 0 Then
Sheets("Admissions").EDAdmit1.Visible = False
Else
Sheets("Admissions").EDAdmit1.Visible = True
End If
If Range("L8").Value = 0 Then
Sheets("Admissions").ElecAdmit1.Visible = False
Else
Sheets("Admissions").ElecAdmit1.Visible = True
End If
If Range("F9").Value = 0 Then
Sheets("Admissions").EDAdmit2.Visible = False
Else
Sheets("Admissions").EDAdmit2.Visible = True
End If
If Range("L9").Value = 0 Then
Sheets("Admissions").ElecAdmit2.Visible = False
Else
Sheets("Admissions").ElecAdmit2.Visible = True
End If
.. and so on.
Not to mention the If Then statements I have for every button click.
Private Sub EDAdmit1_Click()
If Range("F8") = "ICU" Then
Worksheets("Overview").Range("AD11").Value = Worksheets("Overview").Range("AD11") + 1
ElseIf Range("F8") = "HDU" Then
Worksheets("Overview").Range("AF11").Value = Worksheets("Overview").Range("AF11") + 1
ElseIf Range("F8") = "DPU" Or Range("F8") = "Other" Then
Else
Col = WorksheetFunction.VLookup(Range("F8"), Range("U1:V27"), 2)
Worksheets("Overview").Range(Col).Value = Worksheets("Overview").Range(Col).Value + 1
End If
Range("F8").ClearContents
End Sub
Is there a more efficient way of doing this?
Admission List:
You could consider using "admit" hyperlinks in the cells next to the Ward selections: that way you only need one handler (Worksheet_FollowHyperlink in the worksheet module). Note you need to use Insert >> Hyperlink and not the HYPERLINK() formula-type links here (because formula-based links don't trigger the FollowHyperlink event).
You can ditch the hide/show code and instead use conditional formatting to change the link font color to hide the links when there's no Ward selected. If a user clicks on one of the hidden links then you can just do nothing.
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim rngSrc As Range, addr, ward
Set rngSrc = Target.Range '<< the cell with the link
ward = rngSrc.Offset(0, 1).Value '<< cell with Ward
'only do anything if a ward is selected
If Len(ward) > 0 Then
'find the cell to update
Select Case ward
Case "ICU"
addr = "AD11"
Case "HDU"
addr = "AF11"
Case "DPU", "Other"
addr = ""
Case Else
addr = Application.VLookup(ward, Me.Range("U1:V27"), 2, False)
End Select
'if we have a cell to update then
If Len(addr) > 0 Then
With Worksheets("Overview").Range(addr)
.Value = .Value + 1
End With
End If
rngSrc.Offset(0, 1).ClearContents
End If
rngSrc.Select '<< select the clicked-on link cell
' (in case the link points elsewhere)
End Sub
At the beginning of your code put this line:
Application.ScreenUpdating = False
this will disable all screen updates. Let your code do changes, and then enable screen updating, and all your changes will appear.
Application.ScreenUpdating = True
Disabling screen updating usually makes the execution of code faster.
I have built a macro that reads invoices which are in text format into excel.
Now, I wish to create invoice which I can later print. I wish to add a command box next to each invoice number( say name of command box- view/print invoice #).
Which will direct to a new sheet where I will have my respective invoice number.
Where I can view the invoice and quality check and decide to print or not.
Question- How can I add a new command window next to each invoice number?
The function would take the invoice number next to it and all its details- I can do the coding for it. I only wish to know how to make a macro build multiple command windows based on a counter(invoice number here) and how to make those respective command windows have a fixed position in the excel-(next to the invoice number)
Thanks for reading!
This will add a command button next to each invoice number and link it to a macro named "viewInvoice" where you can add whatever code you need. Hope this is what you're looking for!
Option Explicit
Sub addButtons()
Dim x As Variant
Dim lr As Long
Dim bl As Long
Dim bt As Long
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("invoice list") '<<sheet name
.Columns("D").AutoFit '<<assumes invoice number in column D
.Columns("E").Insert
.Columns("E").ColumnWidth = 18.56
.Range("E1").Value = "View Invoice"
.Range("E1").HorizontalAlignment = xlCenter
.Rows("2:" & Rows.Count).RowHeight = 20 '<<assumes data starts on row 2
For Each x In Range(.Range("D2"), .Range("D" & Rows.Count).End(xlUp))
If x.Value <> "" Then
bl = x.Offset(0, 1).Left + 2
bt = x.Top + 2
.Buttons.Add(bl, bt, 100, 16).Select '(from left, from top, button width, button height), adjust as needed
With Selection
.Characters.Text = x.Value
.OnAction = "viewInvoice"
.Placement = xlMove 'or xlFreeFloating or xlMoveAndSize
.PrintObject = False
End With
End If
Next x
.Range("A2").Select
Application.ScreenUpdating = True
End With 'ThisWorkbook.Sheets("invoice list")
End Sub
Sub viewInvoice()
Dim bn As String
bn = Application.Caller
MsgBox "Will display invoice #" & ActiveSheet.Buttons(bn).Text & "!", vbInformation, "View Invoice"
End Sub