Situation
Hello SO,
I have a situation where, I have the following code which I would like to use over other ranges to. But in this case, when the case ranges changes, the clear contents and otehr defined ranges will also change. I find that I have to write a repeatative code for other ranges. Is it possible that I could possibly use another way to define my range and use this code for other range as well. To explain properly, I am finding it difficult but my aim is to optimize the program where I could do by not writing the code again and again but only change of ranges could be porrible.
Sub DescriptionisActivated()
Select Case Range("A12")
Case Is = ""
If Sheet3.Range("B16") <> "" Then
MsgBox "Input1" & vbNewLine & vbNewLine & "-Imput2", vbExclamation, " missing"
Sheet3.Range("B16:L16").ClearContents: Sheet3.Range("A12").Select
End If
Case Is <> ""
If Sheet3.Range("B16") <> "" Then
Sheet3.Range("P16").Interior.Color = RGB(255, 255, 0): Sheet3.Range("B16").Offset(0, 2).Select
Else
Sheet3.Range("N16").Interior.Color = RGB(255, 255, 0): Sheet3.Range("P16").Interior.Color = RGB(255, 255, 0): Sheet3.Range("N16,P16:S16").ClearContents: Sheet3.Range("B16").Select
End If
End Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$16" Then
Sheet3.Unprotect ""
Call DescriptionisActivated
Sheet3.Protect ""
End If
so if you change
Sub DescriptionisActivated()
to
Sub DescriptionisActivated(Target As Range)
and send it a range when you call it i.e.
Call DescriptionisActivated(Target)
then it has a range to start with.
Once that is done you need to change every range refence in DescriptionisActivated to rely on the Target Range. So for example replace:
Range("P16")
with
Target.Offset(0, 14)
be careful as you do this to make ensure that they will point to the right cells that are required for each possible Target you would send to it
let me know how it goes!
Related
I am sure that this is a simple answer, but I am unfamiliar with cases in VBA. What I am trying to do is create a case that monitors specific cells for changes.
If a change to the specified range occurs, then some macro should run as a response to that change. Else, nothing should happen. Here is what I have so far:
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case (Change)
Case Range("A1").Address
Call success
Case Else
'Do nothing
End Select
End Sub
\\\\\\\\\\\\\\\\\\\\\\
Sub success()
' success Macro
Cells(1, 10).Value = "Success!"
End Sub
Problem is that nothing seems to happen. Mind you, this is just a test to understand cases, etc. Once I am provided with a solution I hope to expand this to something more intricate.
I have a feeling that it has something to do with the "Select Case (Change)" portion of the code, but I am unsure. Please don't respond to this question using an if/else statement, I would really like it in the form of a case. Thanks!
Select Case Target.Address(0, 0)
Case "A1": Call success
Case "A2": Call DoSomething
Case Else: Call OtherAction
End Select
NOTE
The Target parameter:
Can be several cells (or whole column or row)
Can contain non-contiguous ranges (in this case, you need to traverse Areas property to get those ranges)
A conciser example would look like that
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const CELL1 = "A1"
Const CELL2 = "C2"
Const CELL3 = "D3"
Dim rg As Range
On Error GoTo ExitSub
Application.EnableEvents = False
Set rg = Union(Range(CELL1), Range(CELL2), Range(CELL3))
If Intersect(rg, Target) Is Nothing Then
' Do nothing
Else
Select Case Target.Address(0, 0)
Case CELL1
Call success(1)
Case CELL2
Call success(2)
Case CELL3
Call success(3)
Case Else
'Do nothing
End Select
End If
ExitSub:
Application.EnableEvents = True
End Sub
Sub success(i As Long)
' success Macro
Cells(i, 10).Value = "Success!"
End Sub
I am attempting to find the text of a header row based on the value of a cell relative to the cell that is clicked in. The way I have attempted to do this is follows:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim var1 As Variant
Dim var2 As Variant
Dim var3 As Variant
Dim FormName As String
FormName = "New Form"
Static NewFormCell As Range
Application.ScreenUpdating = False
If Not Intersect(Target, Range("G16:X80")) Is Nothing Then
If Target.Cells.Count = 1 Then
var1 = Cells(Target.Row, 2).Value
var2 = Cells(15, Target.Column).Value
If Not (IsEmpty(var1)) And Not (IsEmpty(var2)) And var2 <> "+" And Target.Interior.ColorIndex <> 2 And Target.Borders(xlEdgeLeft).LineStyle <> xlNone Then
If IsEmpty(Target) Then
Target.Value = "X"
Target.HorizontalAlignment = xlCenter
Target.VerticalAlignment = xlCenter
Target.Font.Bold = True
Dim Header As Range
Set Header = Range("A54:E160").Find(var2, LookIn:=xlValues)
Header.Offset(1, 1).End(xlDown).EntireRow.Select
Dim CopyCell As Range
'Header.End(xlDown).EntireRow.Insert
'Set CopyCell = Header.End(xlDown). [offset?]
'CopyCell.Value = var1
Else
Target.ClearContents
End If
Else
Exit Sub
End If
End If
End If
Application.ScreenUpdating = True
End Sub
The issue is VBA is throwing Run-Time Error 91 ("Object variable or With block variable not set"). It then highlights the last row in that section of code. Since I set that variable in the previous line, I'm not sure why I'm receiving this error or if I'm even going about this the right way.
Any input would be greatly appreciated!
EDIT: I cleared the above issue by searching over a wider range. The cell I wanted to select was merged, but I still assumed the value was stored within column A. But this code still isn't quite doing what I'd like it to:
I want to select the last row in the section (not the last row of data in the sheet, but the last contiguous data in column B), but right now my code is jumping me all the way to the bottom of the sheet.
The problem is that your .Find isn't finding the value. In this case, you can add some code to handle that.
...
Dim Header As Range
Set Header = Range("A59:A159").Find(var2, LookIn:=xlFormulas)
If Header Is Nothing Then
' There's no value found, so do something...
msgbox(var2 & " was not found in the range, will exit sub now."
Exit Sub
End If
MsgBox Header
...
...of course there are myriad ways/things you can do to handle this. If you still want to execute other code, then wrap everything in an If Header is Nothing Then // 'do something // Else // 'other code // End IF type thing.
It really just depends on what you want to do. Again, your error is being caused by the fact that the var2 isn't being found, so just find other things to do in that case.
I found code online as an example that I have tweaked to show or hide specific rows depending on the selection I choose within a dropdown in my Excel file.
The macro is not working no matter what I try.
My code is as follows (also attached screenshot of rows under question 2 (2a - 2d) that are not showing/hiding)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$13" Then
If Range("F13").Value = "Yes" Then
Rows("14:17").EntireRow.Hidden = False
End If
If Range("F13").Value = "No" Then
Rows("14:17").EntireRow.Hidden = True
End If
If Range("F13").Value = " " Then
Rows("14:17").EntireRow.Hidden = True
End If
End Sub
This is a good example of properly intending your code helping you identify an issue. You're missing an End IF statement. Try this:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$13" Then
If Range("F13").Value = "Yes" Then
Rows("14:17").EntireRow.Hidden = False
End If
If Range("F13").Value = "No" Then
Rows("14:17").EntireRow.Hidden = True
End If
If Range("F13").Value = " " Then
Rows("14:17").EntireRow.Hidden = True
End If
End If
End Sub
You may also want to use:
If Range("F13").Value = ""
instead of
If Range("F13").Value = " "
There is an End If missing. I assume the value of the target cell (F13) needs to be tested for it's value. If the value is "Yes", it should unhide row 14:17, if it is " " (spacebar) it should hide them and if it is "No" is should hide them as well. Other values will not affect the hiding/unhiding of the rows.
There should be a second End If before End Sub, so that all the if-statements above are wrapped within the Address check.
Also note that this code should be placed in the worksheet itself, since you want to hook into the Worksheet_Change event.
Try this in a worksheet module:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$13" Then 'Check if the changed value is indeed in F13
If Target.Value = "Yes" Then
ActiveSheet.Rows("14:17").EntireRow.Hidden = False 'Show the rows if the value is Yes
ElseIf Target.Value = "No" Then
ActiveSheet.Rows("14:17").EntireRow.Hidden = True 'Hide them when it's No
ElseIf Target.Value = " " Then
ActiveSheet.Rows("14:17").EntireRow.Hidden = True 'Or space
End If
End If
End Sub
Other remarks:
Instead of ActiveSheet you can also use Me (Me.Rows...) In this scenario they probably do the same. However, if you change the value on a worksheet from another worksheet (e.g. formula that recalculates), Me will reference the changed worksheet that fires the event, whereas activeworksheet will affect the currently active sheet.
Use Target instead of referencing the Range again. Target is a range object that is already in memory. Hence execution will be faster compared to accessing the worksheet again.
I have several Sheets involved but I'll have Sheet 2 Active. When I'm on "Sheet 2" I need to know when cell ("C14") becomes active with an IF statement I'm guessing. Once it becomes active, I then need to know if the string in cell ("B2") on Sheet 1 = "Fighter" then I want to insert "some wording regarding the fighter here" in cell ("C14") on Sheet 2. IF it's not "Fighter"then is it "Mage"? If so then insert "some wording regarding the mage here".
This is short hand for example.
if cell C14 on Sheet 2 is active then
check cell B2 on Sheet1. If the text = "Fighter"? Then
insert "You are brave and use a sword" into cell C14 Sheet2
if it's not equal to Fighter then is it = "Mage"? Then
insert "You cast spells" in cell C14 sheet2
etc..
I need to know how to code this in VBA. I've spent hours searching and trying various code but can't seem to get it right. Thanks ahead of time for your help.
Try something like this:
'The way you check which cell is active is by using an
'Event like this one. This goes into the Sheet2 code module
'which you can get to by right clicking on the sheet's tab and
'selecting View Code.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng_Source As Excel.Range
Dim rng_Target As Excel.Range
On Error GoTo ErrorHandler
'Setting the cells that you're interested in as
'ranges will help minimise typo errors.
Set rng_Target = ThisWorkbook.Sheets("Sheet2").Range("C14")
Set rng_Source = ThisWorkbook.Sheets("Sheet1").Range("B2")
'Target is a range that specifies the new
'selection. Check its address against rng_Target
'which we defined above.
If Target.Address <> rng_Target.Address Then
Exit Sub
End If
'If you don't want case sensitivity, convert to upper case.
If UCase(rng_Source.Value) = "FIGHTER" Then
rng_Target.Value = "some wording regarding the fighter here"
ElseIf UCase(rng_Source.Value) = "MAGE" Then
rng_Target.Value = "You cast spells"
'You get the idea.
End If
ExitPoint:
On Error Resume Next
'Clean up
Set rng_Source = Nothing
Set rng_Target = Nothing
On Error GoTo 0
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & vbCrLf _
& Err.Description
Resume ExitPoint
End Sub
I do agree with the comments that you should always post the code that you've already tried (which you subsequently did), but this is a relatively trivial one and this just clears it out of the way and may be of use to somebody else as well in the future.
Try this ;)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo errH
Dim rng1 As Range
Set rng1 = ThisWorkbook.Worksheets(1).Range("B2")
If Not Intersect(Target, Me.Range("C14")) Is Nothing Then
Application.EnableEvents = False
If rng1.Value2 = "Mage" Then
Target.Value = "OMG This is MAGE!!! Run run run away!!!"
ElseIf rng1.Value2 = "Fighter" Then
Target.Value = "Fighter? :/ Was hoping for something better"
MsgBox "Fighter? :/ Was hoping for something better"
rng1.Value2 = "Mage"
Target.Value = "Mage. Now This is better ;)"
Else
Target.Value = "No, we haven't discussed it."
End If
Application.EnableEvents = True
End If
Exit Sub
errH:
MsgBox ("Error number: " & Err.Number & "Description: " & Err.Description)
Application.EnableEvents = True
End Sub
I have the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
Dim StartBox As Long
Dim StartBox2 As Long
Select Case UCase(Target.Value)
Case "NEW-BOX"
StartBox = ActiveCell.Row
StartBox2 = ActiveCell.Column
MsgBox (StartBox)
MsgBox (StartBox2)
Selection.Offset(-1, 2).Select
Selection.ClearContents
Selection.Activate
Selection.Offset(1, -2).Select
Case "RESTART-BOX"
MsgBox (StartBox)
MsgBox (StartBox2)
If StartBox = 0 And StartBox2 = 0 Then
MsgBox "Cannot restart box without scanning a new box first!", vbCritical
ElseIf StartBox <> 0 And StartBox2 <> 0 Then
ActiveSheet.Range(Cells(StartBox, StartBox2), Cells(ActiveCell.Row, ActiveCell.Column)).ClearContents
End If
End Select
End Sub
I scan a new box, and the variables set to the correct columns and row, but when I scan restart box, the message boxes both come up 0? Why is this? I need to pass these variables onto my code to clear the contents, but for some reason even though I am setting them they won't appear in 'RESTART-BOX' ?
We need more context to be able to provide a definitive answer. Is your code in a loop of some sort or is this a sub or function being called multiple times?
If the latter then you will get a new copy of StartBox and StartBox2 created each time you call the sub / function, so they won't retain the values. If you place the dim statements outside the sub or function then they will become global variables and will retain their values across each call to the sub or function.
You'll need to set your 2 variables before your select statement:
...
StartBox = ActiveCell.Row
StartBox2 = ActiveCell.Column
Select Case UCase(Target.Value)
...