Run Macro Dropdown List Excel - vba

I wrote this Macro out to copy and paste info from a previous sheet to the active sheet. I want to make this into a dropdown list but when using data validation, the macro doesn't run when it is picked. Attached is my code and I am wondering should I make a list box or should I stick with data validation? I know there's a way to make a macro run once clicked in a click box
Sub WorkDay1()
ActiveSheet.Range("A6:H44").Value = Worksheets("Route Sheet - Manhattan 1").Range("A6:H44").Value
End Sub
Sub WorkDay2()
ActiveSheet.Range("A6:H44").Value = Worksheets("2").Range("A6:H44").Value
End Sub
Sub WorkDay3()
ActiveSheet.Range("A6:H44").Value = Worksheets("3").Range("A6:H44").Value
End Sub
Sub WorkDay4()
ActiveSheet.Range("A6:H44").Value = Worksheets("4").Range("A6:H44").Value
End Sub

Assuming your dropdown list is in cell A1.
Paste this code into the worksheets code module.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("A1")) Is Nothing Then
Select Case Target.Value
Case "WorkDay1"
WorkDay1
Case "WorkDay2"
WorkDay2
Case "WorkDay3"
WorkDay3
Case "WorkDay4"
WorkDay4
End Select
End If
Application.EnableEvents = True
End Sub
In the VBA Project explore double click the Sheet that you wish to run the macro on. This will open up the code module for that sheet. Then paste the code into that module.
Adding this colud will update the values when you select the worksheet.
Private Sub Worksheet_Activate()
Select Case Range("A1")
Case "WorkDay1"
WorkDay1
Case "WorkDay2"
WorkDay2
Case "WorkDay3"
WorkDay3
Case "WorkDay4"
WorkDay4
End Select
End Sub

Related

how to allow only specific users to unhide a worksheet

I already have a macro below that un-hides a worksheet at the click of a button and works okay. However I want this macro to be changed so that ONLY two users (whose usernames are "JSMITH" AND "DTAYLOR") are able to unhide this sheet called "Rates".
If someone else (whose username is not one of the two mentioned above) tries to unhide the sheet, I want Excel to display a message "you're not authorised to open this".
Moreover, I need to make sure that only those two users are able to un-hide in a traditional way without vba (eg by right-clicking on a visible worksheet tab and choose Unhide or from any worksheet tab, choose Format, Sheet, and then Unhide).
Could you please advise how to modify the following code to do the all the things described above?
I came up with this but it doesn't work:
Sub GoToRates_WS()
Select Case Environ$("username")
Case "jsmith", "taylor"
Worksheets("Rates").Visible = True
ThisWorkbook.Sheets("Rates").Activate
Case Else MsgBox "you're not authorised to open this"
End Select
End Sub
1- Open your ThisWorkbook code Module.
2- Paste this line at the top of it:
Private RatesVisible As Variant
3- find the following routine:
Private Sub Workbook_Open()
...
...
End Sub
Insert the following line just before the line End Sub:
RatesVisible = Worksheets("Rates").Visible
4- Delete your old routine GoToRates_WS
5- Copy the following code and paste it at the end of the code module:
Private Function privilegedUser() As Boolean
Select Case UCase(Environ$("username"))
Case "JSMITH", "DTAYLOR"
privilegedUser = True
Case Else
End Select
End Function
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
RatesVisible = Worksheets("Rates").Visible
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name <> "Rates" Then
RatesVisible = Worksheets("Rates").Visible
Exit Sub
End If
If privilegedUser Then
RatesVisible = Worksheets("Rates").Visible
Else
Worksheets("Rates").Visible = RatesVisible
End If
End Sub
Private Sub GoToRates_WS()
If privilegedUser Then
RatesVisible = xlSheetVisible
Worksheets("Rates").Visible = xlSheetVisible
Else
MsgBox "You are not authorized to open this worksheet"
End If
End Sub

VBA cells are not highlighted

Its a protected worksheet/workbook and I have a code that will throw a prompt for the user, whether to edit the sheet or not. Cells are editable, but the problem is cells are not getting highlighted with border. So its difficult for the user to know which cells is he working on.
I have 2 sheets here, Corefiller and Ad-filler, if dropdown on corefiller sheet is "No". User gets a prompt when he selects the sheet, he clicks ok to edit the sheet or cancel if he doesnt want to edit.
Code on Sheet "Ad-filler"
Option Explicit
Private mMessageDisplayed As Boolean
Private Sub Worksheet_Activate()
Carry
End Sub
Code on a module.
Public Sub Carry()
If ActiveSheet.ProtectContents And Not mMessageDisplayed Then
mMessageDisplayed = True
If ThisWorkbook.Sheets("Corefiller").Range("E29") = "NO" Then
If MsgBox("Click OK to include Filler for this request", vbOKCancel + vbInformation) = vbOK Then
ThisWorkbook.Worksheets("Corefiller").Range("E29") = "YES"
With ThisWorkbook.Sheets("Ad-filler")
.Range("E13:E14").Locked = False
End With
Else
With ThisWorkbook.Sheets("Ad-filler")
.Range("E13:E14").Locked = True
End With
End If
Else
Exit Sub
End If
End If
End Sub
Whats wrong in my code? why the cell is not highlighted. If i try to use protect/unprotect in the code, cells on the first sheet (Corefiller) will not be highlighted and I have to click on other sheets and come back to get the cell highlighted.
Can you restart, implement this and check whether the problem still exists:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = 0
Target.Interior.ColorIndex = 3
End Sub

Run Event Macro After Data Validation Selection

I built up a data validation list on the sheet called report, I need to run a macro each time I select an item from the list. Now that I have this code below, but it doesn't work. It does run in VBA, but it will not run when I choose the Item in my worksheet, it seems like I didn't refer to the macros
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address(True, True) = "$B$3" Then
Select Case Target
Case "ABCP"
Call Macro1
Case "Accounting Policy"
Call Macro2
Case Else
'Do Nothing
End Select
End If
End Sub
If you want to run the procedure when you have changed the value in B3 (picking from the data validation list, then you want a Worksheet_Change event macro, not a Worksheet_SelectionChange.
Additionally, if anything on the worksheet is going to change then you will want to disable events so the event macro does not attempt to run on top of itself.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$3" Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Select Case Target.Value2
Case "ABCP"
Call Macro1
Case "Accounting Policy"
Call Macro2
Case Else
'Do Nothing
End Select
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
This should launch the correct sub procedure when B3 has a new value selected from the list. You would have to provide more details (and code) for m Macro1 and Macro2 if it continues to be problematic.
The above code appears to work fine for me.
Have you placed the code in the worksheet code? as opposed to a Module?

Reuse UserForm VBA Code for Multiple Date Pickers in Same Worksheet

I'm wondering how to reuse the VBA code that I have to create multiple Calendar date pickers on the same worksheet that will input to different cells. I have tried changing the name of the .frm file and re-importing it to simply change the cell reference output, but Excel rejects this every time and says the name is already in use. I'm closely following this example.
Bonus points if you know code for how to hide the clickable image until the cell with the date is selected.
Here is the code that I am working with so far in frmCalendar:
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
On Error Resume Next
Dim cell As Object
For Each cell In Range("C18")
cell.Value = DateClicked
Next cell
Unload Me
End Sub
Private Sub UserForm_Initialize()
If IsDate(ActiveCell.Value) Then
Me.MonthView1.Value = Range("C18")
End If
End Sub
...and my code for Module1:
Sub Sample()
frmCalendar.Show
End Sub
So basically, I have one calendar that unloads into C18. However, I would like to have up to 10 calendar buttons in my worksheet that have different output cells so they can all have different dates.
Here is an example where the calendar button outputs to C18. It has been assigned the Macro "Sample"
So how can I reuse my code for multiple calendar buttons? Bonus if there is code to hide the calendar buttons until the cell is selected.
You can store the selected cell when the form opens and use that when you close it.
Dim cell As Range 'selected cell when launched
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
On Error Resume Next
cell.Value = DateClicked
Unload Me
End Sub
Private Sub UserForm_Initialize()
Set cell = Selection.Cells(1)
If IsDate(cell.Value) Then
Me.MonthView1.Value = cell.Value
End If
End Sub

Excel Userform with Textbox, how to toggle through values in range of textbox

Purpose: Click on a cell in a range (Range: Column K:K on excel worksheet). Once you click on a specific cell in column K, userform pops up with cell value using following code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("K:K")) Is Nothing Then
Credit_Information.TextBox1.Value = Target.Value
Credit_Information.Show
End If
End Sub
My question, is depending on where I click on column K, I want to use two buttons on my userform (Previous and Next) to move up and down column K and see the values of the cell dynamically change on my userform. Is this possible? Please let me know if any clarification is needed.
Just add the two command buttons to your userform.
Name one of the buttons cmdNext and give it a caption of "Next".
Name the other button cmdPrev and give it a caption of "Previous".
Then, in the userform code module, place these routines:
Private Sub cmdNext_Click()
ActiveCell(2).Select
End Sub
Private Sub cmdPrev_Click()
If ActiveCell.Row > 1 Then ActiveCell(0).Select
End Sub
That's it.
Note: if you want you can add code to ensure that the ActiveCell is in column K before allowing the new selections:
If ActiveCell.Column = 11 Then ...
Perfect, Thanks!
I also found out that using Offset worked for me too in this manner. I'm not sure however if I'm breaking any conventions by doing this.
Private Sub CommandButton1_Click()
ActiveCell.Offset(-1).Activate
End Sub
Private Sub CommandButton2_Click()
ActiveCell.Offset(1).Activate
End Sub
It is possible, but I would create another procedure for that. What you could do is declare a public variable in your userform & set it equal to the range Target. Then you could call another procedure from the userform on each button click and redefine the selected range after each click.
So, at the top of your userform do this:
Public selected_cell as Range
Then for the up button:
Private Sub ButtonUp.Click()
If selected_cell.Row < 2 Then Exit Sub
selected_cell.Rows(0).Select
Set selected_cell = selected_cell.Rows(0)
me.TextBox1.Value = selected_cell
End Sub
And the down button would be:
Private Sub ButtonDown.Click()
selected_cell.Rows(2).Select
Set selected_cell = selected_cell.Rows(2)
me.TextBox1.Value = selected_cell
End Sub
Now let's make your code like this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("K:K")) Is Nothing Then
With Credit_Information
Set .selected_cell = target
.TextBox1.Value = Target.Value
.Show
End With
End If
End Sub