I'm very new to creating macros and programming in general. I have a worksheet of 38 tabs. 31 tabs are for the days of the month. I would like to create a macro that will prompt users with a warning message any time "MCO" is selected in column N for each of these 31 tabs. Is that possible?
Thanks
It is possible, using a workbook level SheetSelectionChange event. In the ThisWorkbook module in your VBA project paste the following code:
Option Compare Text
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim SelectedCellsInColN As Range
' Make a range of the cells in Target range that intersect with the cells in the N column
Set SelectedCellsInColN = Intersect(Target, Target.Parent.Range("N1:N" & CStr(Target.Parent.Rows.Count)))
If Not SelectedCellsInColN Is Nothing Then
' The user has selected a cell in column N
Dim CurrCell As Range
For Each CurrCell In SelectedCellsInColN
' If the cell's value contains mco (in any case) then prompt the user with a messagebox
If CurrCell.Value Like "*MCO*" Then
MsgBox "You've selected MCO"
' Exit the sub so we don't keep bugging the user about it...
Exit Sub
End If
Next CurrCell
End If
End Sub
Basically what the code does is look at the Target range to see if any cells in the N column are selected, and then loops through any of those cells in column N that are selected to see if their value contains MCO (you can get rid of the stars if you only want a prompt when the cell contains just "MCO"), and if so prompts the user and exits out.
Hope that helps.
-Jon
Are you looking for a macro solution or a vba solution. The two are different. For the macro run through the steps using the macro recoder, for a VBA solution start with Jon's answer
Related
I've got the below code that works well, however I have soo many sub accounts(like "Ads_20_21") that I have to replicate the code many times over and create new named ranges to what is essentially just hiding/unhiding 3 rows below for every sub account. Is there a code that I can assign to a button that will just hide/unhide 3 rows below the active cell, I've tried looking everywhere for help but no luck. Much appreciated for any help.
Sub ToggleHiddenRow(rng As Range)
With rng.EntireRow
.Hidden = Not .Hidden
End With
End Sub
Sub Ads_20_21()
ToggleHiddenRow ActiveSheet.Range("Advertising_20_21")
End Sub
I suggest this code:-
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Const TriggerClm As String = "A" ' change to suit
Const FirstDataRow As Long = 2 ' change to suit
Const RowsToHide As Long = 3 ' change to suit
Dim Rng As Range
Set Rng = Range(Cells(FirstDataRow, TriggerClm), Cells(Rows.Count, TriggerClm).End(xlUp))
If Not Application.Intersect(Target, Rng) Is Nothing Then
Set Rng = Range(Rows(Target.Row + 1), Rows(Target.Row + RowsToHide + 1))
Rng.Rows.Hidden = Not Rng.Rows(1).Hidden
Cancel = True
End If
End Sub
It's an event procedure that responds to the double-click event, meaning it runs when you double-click a cell. The event will be taken note of only in the code module of the sheet on which you want the action. Therefore it's essential that the procedure is installed in that module and nowhere else. Because of the special connection this module has to what's happening on the worksheet Excel sets up this module when a tab is created. Use the existing module, not one that you insert yourself.
The 3 constants at the top of the code are for you to adjust. Determine the column you want to double-click, the first data row and the number of rows you want to hide/show, starting from the row below the row you double-clicked. The procedure will not run when you double-click another column or above the first data row. When it runs, it will hide the 3 rows if they are visible or unhide them if they are hidden.
I would look for a way for the program to know when a row is clicked that pertains to a subaccount and skip the action for such rows. If you have such a criterium, establish it in code before If Not Application.Intersect(Target, Rng) Is Nothing Then and then include it in that same line. However, as the code is now, there won't be any big punishment for clicking the wrong row. Undoing the action just takes one double-click.
I want my macro to stop if there's no value entered in any of the four cells I need. But i want it to run if there's at leats one value in those four cells.
This is what i have so far:
If Range("e12,h12,k12,d12").Value = "" Then
MsgBox ("Por favor introducir dimensiones")
Range("e12").Select
Exit Sub
End If
If you introduce a value in cell e12, it will run. But if you introduce a value in any other cell, the msgbox will pop out and the macro will stop.
Could you help me find the problem?
Thank you!
Please install the event procedure below in the code sheet of the worksheet on which you want the action.
Private Sub Worksheet_Change(ByVal Target As Range)
Const Triggers As String = "E12,H12,K12,D12"
Dim Rng As Range
Dim Cell As Range
' skip if more than one cell was changed (like paste)
If Target.Cells.CountLarge = 1 Then
Set Rng = Range(Triggers)
For Each Cell In Rng
If Cell.Value = "" Then
Cell.Select
Exit For
End If
Next Cell
End If
End Sub
Now, if the user enters something in E12 the macro will select H12. If the user enters something in D12 next the macro will take him back to K12. That's all very nice.
But if the user changes something in A3 (anywhere, in fact) he will be taken to the first empty cell of the trigger range. Therefore the system must be tweaked to accommodate your workflow. Perhaps the code should be made to run only when D12 is entered, or when the user clicks on the cell he shouldn't click on before completing the trigger range.
In short, the scope of the procedure may have to be trimmed to suit your workflow. This can be done by either including specific cells in the trigger range, or by excluding other cells.
you coudl use WorksheetFunction.CountA() function to count the number of not empty cells:
If WorksheetFunction.CountA(Range("e12,h12,k12,d12")) <> 4 Then
MsgBox ("Por favor introducir dimensiones")
Range("e12").Select
Exit Sub
End If
I am trying to unhide a group of worksheets if they meet a certain condition. This uses a user form, triggered by a command button, with selection options and another command button. The expected behavior is that once the selection has been made and the button has been pressed, all worksheets meeting the criteria will be unhidden. The Target word is present at different locations along the first row and all cells before it are empty on that row. Ideally, the process will scan each cell in the first row of each worksheet in the workbook until it comes across the Target, unhide the worksheet, then move on to the next worksheet to start the process over again until all worksheets with the workbook have been checked.
Upon activation of the command button on the user form I have the following:
Private Sub ContinueCommand_Click()
Dim Valid As Boolean, wks As Worksheet, c As Integer, actCol As Long
actCol = ActiveSheet.Range("A1").End(xlToRight).Column
For Each wks In ActiveWorkbook.Worksheets
For c = 1 To actCol
If ActiveCell.Value = "Target" Then
wks.Visible = xlSheetVisible
Exit For
End If
Next c
Next wks
Valid = True
If Valid = True Then
Unload Me
End If
End Sub
I've borrowed from several sources, including here for using ActiveCell, determining if a value exists, unhidding worksheets, Finding values within a range, and searching for a string. Any help would be greatly appreciated.
As I said in my comments there are some issues with the way you've chosen to implement this.
Your For c = 1 To actCol loop is not needed. This can be easily seen because c is not really used anywhere in the loop.
Let's assume your Target value is in wks.Range("A100") (the 1st row and 100th column).
Your code would then perform the exact same operation 100 times and would come up with the exact same result. That's what leads you to use Exit For, which is a bad practice.
If I understood your initial post correctly, if Target exists in a particular worksheet, then all cells before Target are empty.
If that's the case, the Target will either be in wks.Range("A1") or in wks.Range("A1").End(xlToRight). If it's not in either of these two cells then it doesn't exist at all in this particular worksheet, which would mean that the 1st row is completely empty. You don't need to check any more cells apart from these two.
Your code does not check whether Target is in wks.Range("A1").
Also your use of Application.Match, makes me believe that you have probably been misled by the common misconception that wks.Range("A1").End(xlToRight) is a range of cells starting from A1 and extending all the way to the last non-empty cell in the 1st row.
The truth is that wks.Range("A1").End(xlToRight) is a single cell rather than a range of cells. Selecting A1 and then pressing CTRL+right arrow, will show you exactly which cell it is.
I might be missing something, but according to your description in the initial post, I would do something like the following:
Dim sht As Worksheet
For Each sht In ThisWorkbook.Worksheets
If sht.Range("A1").Value = "Target" Or sht.Range("A1").End(xlToRight).Value = "Target" Then
sht.Visible = xlSheetVisible
Else
MsgBox "target was not found in " & sht.Name
End If
Next sht
I want to thank BruceWayne, Scott Craner, Stavros Jon, Darell H whom all helped me get closer to this answer. The final result looked like this:
Private Sub ContinueCommand_Click()
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
If Not IsError(Application.Match("Target", wks.Range("A1").End(xlToRight), 0)) Then
wks.Visible = xlSheetVisible
End If
Next wks
Unload Me
End Sub
If anyone in the future has issues getting this to work, let me know and I will post a more complete version.
I am designing a time report for my colleagues. There are cells which contain a (hidden) formula but are unprotected because I need the user to still be able to manually override the formula.
Now, if a user enters his/her own content and then deletes it again, the cell is empty, which is what I don't want, as it will only lead to confusion.
I want to write a VBA macro which recognizes if the cell contents in a previously declared range are deleted / empty and if they are deleted / empty, then a formula from another (password-protected and hidden) cell should be copied to the empty cell.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange As Range
Set myRange = Intersect(Range("F9:I108"), Target)
If Not myRange Is Nothing Then
'I'm guessing something with WorksheetFunction and possibly CountA,
'but I don't know how to make it work
End If
End Sub
The formulas which should be entered if the content of a cell (or of multiple cells) is deleted is always in line 117 (same worksheet). For example, if the user deletes G50, then G117's formula should be copied into G50 in the same way you usually copy formulas in Excel (so if there's a non-$-reference in G117 that points to A117, it should then point to A50 after the formula is copied to G50).
If possible, I want to work without loops--they always take so long to execute.
Thanks in advance!
Here is a super simple example that involves only 3 cells, A1, A2 and A3. You must modify this to accommodate your formula-cells.
We first create a secret worksheet (called secret). We place the formulas from A1 through A3 from the main worksheet into the secret sheet, but we store them as Strings rather than Formulas:
Then we put the following worksheet event macro in the main sheet:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("A1:A3")
If Intersect(Target, rng) Is Nothing Then Exit Sub
If Target.Count <> 1 Then Exit Sub
If Target.Value <> "" Then Exit Sub
Application.EnableEvents = False
Target.Formula = Sheets("secret").Range(Target.Address).Value
Application.EnableEvents = True
End Sub
The sub monitors changes to the three cells and if any of them are cleared, that formula will be restored from the secret worksheet.
Because it is worksheet code, it is very easy to install and automatic to use:
right-click the tab name near the bottom of the Excel window
select View Code - this brings up a VBE window
paste the stuff in and close the VBE window
If you have any concerns, first try it on a trial worksheet.
If you save the workbook, the macro will be saved with it.
If you are using a version of Excel later then 2003, you must save
the file as .xlsm rather than .xlsx
To remove the macro:
bring up the VBE windows as above
clear the code out
close the VBE window
To learn more about macros in general, see:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
and
http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx
To learn more about Event Macros (worksheet code), see:
http://www.mvps.org/dmcritchie/excel/event.htm
Macros must be enabled for this to work!
Here's another possible answer. In order to copy the formula and have it maintain the "relative addressing" of the formula, you need to copy using the R1C1 notation. So a quick sub for this could look like
Option Explicit
Sub RestoreFormula(ByRef emptyCell As Range)
Dim formulaWS As Worksheet
Dim formulaCell As Range
Set formulaWS = ThisWorkbook.Sheets("Sheet1")
Set formulaCell = formulaWS.Range("A17")
emptyCell.FormulaR1C1 = formulaCell.FormulaR1C1
End Sub
The important line here is the emptyCell.FormulaR1C1 = formulaCell.FormulaR1C1 part.
Then, over in the Worksheet_Change event it could look like this
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim checkRange As Range
Set checkRange = ActiveSheet.Range("A1:A9")
If Not Intersect(checkRange, Target) Is Nothing Then
Dim changedCell As Range
For Each changedCell In Target
If IsEmpty(changedCell) Then
RestoreFormula changedCell
End If
Next changedCell
End If
End Sub
If anyone else ever has the same problem and maybe wants to use my solution, which is a combination of PeterT's and Gary's Student's suggestions (thank you both so much):
First I created a new worksheet, in which I copied all of the formulas I wish to retain. I made sure to copy them to the exact same cell as in the original sheet.
Then I appended this code to the original worksheet:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich1 As Range
Set Bereich1 = Range("F9:I108") 'Do NOT enter multiple, non-contiguous ranges here! It crashes Excel!
If Not Intersect(Bereich1, Target) Is Nothing Then
Dim changedCell1 As Range
For Each changedCell1 In Target
If changedCell1 = "" Then
changedCell1.Formula = Sheets("Tagebuch_secret").Range(changedCell1.Address).Formula
End If
Next changedCell1
End If
Dim Bereich2 As Range
Set Bereich2 = Range("E112") 'instead duplicate the code snippet
If Not Intersect(Bereich2, Target) Is Nothing Then
Dim changedCell2 As Range
For Each changedCell2 In Target
If changedCell2 = "" Then
changedCell2.Formula = Sheets("Tagebuch_secret").Range(changedCell2.Address).Formula
End If
Next changedCell2
End If
End Sub
This works fine for every scenario in which cell contents get deleted, both if the user deletes contents of a single or multiple cells!
My next step is to make the _secret sheet very hidden, password-protect the workbook structure and then password-protect my vba project. Then only people who know the password (me) can destroy my file :)
I am trying to use a button in Excel to copy a certain range of cells from the active workbook to another workbook. The copying works perfectly when I specify a fixed range for each button in its assigned Macro but I'm stumped as to how to use the same Macro on each button and for the button's row number to indicate the row of data to be copied.
Every row contains 6 or so cells with the 7th containing the button. When the user presses this button the 6 cells on the same row as the row containing the pressed button need to be copied.
I am a complete novice when it comes to VBScript but much googling has got me this far:
Sheets("SurfaceThreats").Range("A4:F4")Copy_
Sheets("ORBAT").Cells(Rows.Count,1).End(x1Up).Offset(1,0)
Surely there is a more elegant solution than assigning a different, fixed range, Macro to every button.
See this screenshot
And this is the code for the Select Row(s) button
Option Explicit
Private Sub CommandButton1_Click()
Dim Ret As Range, rng As Range
Dim lRow As Long
On Error Resume Next
Set Ret = Application.InputBox("Please select the row", Type:=8)
On Error GoTo 0
If Not Ret Is Nothing Then
For Each rng In Ret.Rows
'~~> Get the last row in sheets "ORBAT" where you want to copy
With Sheets("ORBAT")
lRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End With
'~~> Copy the rows
Sheets("SurfaceThreats").Range("A" & rng.Row & ":F" & rng.Row).Copy _
Sheets("ORBAT").Cells(lRow, 1)
Next
End If
End Sub
You can't create a generic button handler, but you can dynamically create the buttons and the macros to handle them. But it's quite a lot of work and you'll have to start creating macros dynamically. (this can cause problems with anti-virus software sometimes i think).
You could use the Worksheet_OnBeforeDoubleClick event to create "fake" buttons
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Target.Worksheet.Columns(1)) Is Nothing Then
MsgBox "You Clicked " & Target.Address
' call your generic handler here passing the Target.Address or Target.Row
Cancel = True
End If
End Sub
Using this code, if you double click any cell in the "A" column you'll get a message box saying what cell you clicked.
Its not the best of ideas, some users might not understand that it is a button.