I'm trying to write a VBA macro (which I'll attach to a command button) which searches K7 through K13 to find "Sheet1", "Sheet2", "Sheet3", or "Sheet4" Only one answer is possible based on pre-existing If/Then statements.
When it finds "Sheet1" I want it to run macro "GoToSheet1"
When it finds "Sheet2" I want it to run macro "GoToSheet2"
When it finds "Sheet3" I want it to run macro "GoToSheet3"
When it finds "Sheet4" I want it to run macro "GoToSheet4"
Basically i have four possible conditions which could exist based on how someone answers two yes/no questions. That is what the initial if/then statements cover. However, I cannot get the VBA macro to search across the cell range K7 through K13 for any one of the four text phrases.
Surely you can loop thru the range K7:K13 for checking each cell values. However using Range.Find method would be a better way to do this.
Private Sub CommandButton1_Click()
Dim lookingRange As Range
Set lookingRange = Range("K7:K13")
If Not lookingRange.Find(What:="Sheet1", LookIn:=xlValues) Is Nothing Then GoToSheet1: Exit Sub
If Not lookingRange.Find(What:="Sheet2", LookIn:=xlValues) Is Nothing Then GoToSheet2: Exit Sub
If Not lookingRange.Find(What:="Sheet3", LookIn:=xlValues) Is Nothing Then GoToSheet3: Exit Sub
If Not lookingRange.Find(What:="Sheet4", LookIn:=xlValues) Is Nothing Then GoToSheet4: Exit Sub
MsgBox "not found"
End Sub
Related
I'm trying to create a drop-down in Excel where the user can select a macro from the drop down and the designed macro will run. For instance, selecting "Walmart" from the drop down will the run the Walmart designed Macro. Selecting "Sears" will run the Sears Macro. And so on. I've tried extensive research online, and tried everything from online code ranging utilization of cases to combo boxes and nothing has worked. Really stumped at this for some reason, and would appreciate any help.
Here's something that I wrote recently for a similar issue. Here the dropdown is in cell A1. The macro below resides under the sheet where the dropdown is located, not a separate module. All macros that are being referred to are Public.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A1")
Application.EnableEvents = False
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Select Case Range("M2")
Case "Macro1": Run "Macro1"
Case "Macro2": Run "Macro2"
Case "Macro3": Run "Macro3"
End Select
End If
Application.EnableEvents = True
End Sub
I am having a tiny problem with Inserted hyperlinks. If I start with a blank sheet and insert a hyperlink and then copy it to two other cells using two individual Copy/Pastes:
Sub hyper1()
Cells.Clear
With ActiveSheet
.Hyperlinks.Add Anchor:=Range("A1"), Address:="http://www.cnn.com/", TextToDisplay:="News"
Range("A1").Copy Range("A2")
Range("A1").Copy Range("A3")
MsgBox .Hyperlinks.Count
End With
End Sub
Three cells get filled and Excel correctly reports the number of hyperlinks as 3.
However if I fill the second two cells with a single Copy/Paste:
Sub hyper2()
Cells.Clear
With ActiveSheet
.Hyperlinks.Add Anchor:=Range("A1"), Address:="http://www.cnn.com/", TextToDisplay:="News"
Range("A1").Copy Range("A2:A3")
MsgBox ActiveSheet.Hyperlinks.Count
End With
End Sub
The same three cells get filled, but Excel reports the number of hyperlinks as 2!!
Which is broken, Excel 2007 or my computer ??
Sub hyper3()
Cells.Clear
With ActiveSheet
.Hyperlinks.Add Anchor:=Range("A1"), Address:="http://www.cnn.com/", TextToDisplay:="News"
Range("A1").Copy Range("A2,A3")
MsgBox ActiveSheet.Hyperlinks.Count
End With
End Sub
The comma separation splits them into two ranges instead of one
I suspect its because in the second macro, the hyperlink is copied as a single range object as opposed to two individual ranges (like the first one).
Excel will treat this as a Range object (that represents the range the specified hyperlink is attached to). It will therefore count this as one hyperlink instead of two.
You can see this if you click either of cells A2 or A3 after the macro has run (they will both change colour at the same time indicating that the hyperlink has been selected).
I want to write a simple VBA macro to copy the data in a range that corresponds to the block of cells around an active cell in Sheet1 and Paste it in Sheet2. (preferably in the same address as of in Sheet1).
The code I have written is:
Option Explicit
Dim Cello As Range
Sub CopyCurrentRegion2()
Set Cello = Worksheets("Sheet1").Range(ActiveCell.Address)
Cello.CurrentRegion.Copy Sheets("Sheet2").Range(Cello)
End Sub
Please correct this prog. It is giving run time error: 1004.
Consider:
Sub CopyStuff()
With ActiveCell.CurrentRegion
.Copy Sheets("Sheet2").Range(.Address)
End With
End Sub
I am trying to automate a macro to run on sheet2 whenever a cell within a range on sheet1 is changed. I have tried a bunch of things and I don't have the vba experience to know what is wrong with them. Basically, sheet1 has my input, and I assigned a level of priority 1-5 to each item. Sheet2 shows only those items ranked 1, 3, or 4. I did this with if statements, but this leaves a bunch of blank rows in my table, so I can sort the blank rows out using the filter function. If I change a ranking on sheet1, I want my sheet2 table to automatically update. I wrote a sort function which resorts my sheet2 data appropriately but I am struggling to automate it so that it updates automatically when anything from sheet1 is changed. So far I have been using worksheet_change and can get sheet1 to refilter when sheet1 is changed, which is not what I want. Any ideas?
This is my current sort function:
Sub ReSort()
With Worksheets("Sheet2")
.Range("$A$2:$D$34").AutoFilter Field:=2
.Range("$A$2:$D$34").AutoFilter Field:=2, Criteria1:="<>"
End With
End Sub
This:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
' Do something
End If
End Sub
Should do the trick
I finally got it to work! For those reading this and having a similar problem, I have this code saved in sheet1:
Sub ReSort()
'This function filters my table spanning A2:D34 by the second column and sorts out the blanks
With Worksheets("Sheet2")
.Range("$A$2:$D$34").AutoFilter Field:=2
.Range("$A$2:$D$34").AutoFilter Field:=2, Criteria1:="<>"
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'This function runs my ReSort function if any cell on sheet1 in E3:E34 or G3:G34 is changed
If Not Intersect(Target, Range("$E$3:$E$34,$G$3:$G$34")) Is Nothing Then
ReSort
End If
End Sub
Thanks to everyone for their help! I was seriously pulling my hair out in frustration with this.
Sounds like you're on the right path, worksheet_change is the correct way to go with this as you do want the macro to run when sheet1 is changed so you need to detect that.
I suspect you're just missing one thing, the macro that runs on sheet2, put it in a module reference sheet2 explicitly
For example,
Worksheets("Sheet1").Range("A1")
instead of just
Range("A1")
Then you can call the function to run from any sheet just by using the function name
If you need more detail, post all of the code you have so far and I will happily modify it to suit
My workbook consists of almost 25 sheets, I want to protect 11 sheets. My criteria for protecting are as follows:
1. User cannot delete or modify any cell
2. User should be able to use SORT, AUTOFILTER, drop down selection from COMBO BOXES
3. Most of the sheets contain charts, they should be updated as per the user selection
4. User should not be able to see the formulas in the formula bar
5. User should be able to copy the data
I have tried all the general options in Excel, which does all the above work, but they leave the cells unlocked, which means user can delete the contents
Thus I hope this can be achieved only by a macro, please help.
I have tried all the general options in Excel, which does all the above work, but they leave the cells unlocked, which means user can delete the contents
Since every thing else works for you, I will not try to address those. With already what you have, add this code in the worksheet code area
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Dim rng As Range
Application.EnableEvents = False
For Each rng In Target
If rng.Value = "" Then
Application.Undo
Exit For
End If
Next
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub