I am creating a function where if a cell has Yellow color and if I enter 0 in that cell, then it pops up a message box Red then colors the cell Red. And then if I enter 1 it reverts the color to Yellow.
Here's my code:
Function ColorChange(range)
If range.Interior.ColorIndex = 6 And range.Value < 1 Then
MsgBox "Project Delay!", vbCritical, "Attention required!"
range.Interior.ColorIndex = 3
Else
If range.Interior.ColorIndex = 3 And range.Value > 0 Then
range.Interior.ColorIndex = 6
End If
End If
End Function
1) It is not necessary to use a function. In VBA you can program classically (and run the macro manually) or you can program event. It means that a macro will be running in case of a particular event (like a mouse-click or a modification in the sheet). That is why Siddarth Rout spoke about Worksheet_change, it is an event. In this case, define your Sub in this way and the following code will be executed in case of Worksheet modification.
2) You have to define a Private Sub for the specific worksheet. Private Sub Worksheet_change() and you put in argument ByVal Target As range. It means that you will receive information about the range that have been changed (Target).
3) After you will use Target.Address to define the range used by your code.
4) Your 2 intricate if statements are not necessary. It is better to use an if statement and an else if statement.
5) The following code is OK for me:
Private Sub Worksheet_change(ByVal Target As range)
If range(Target.Address).Interior.ColorIndex = 6 And range(Target.Address).Value < 1 Then
MsgBox "Project Delay!", vbCritical, "Attention required!"
range(Target.Address).Interior.ColorIndex = 3
ElseIf range(Target.Address).Interior.ColorIndex = 3 And range(Target.Address).Value > 0 Then
range(Target.Address).Interior.ColorIndex = 6
End If
End Sub
Related
I have a function ChangeTypeByDoubleClick assigned to the button Change Type in Bulk, this ChangeTypeByDoubleClick function throws a Type Mismatch Error.
Logic of my code & how it went wrong
To explain what is Change Type in Bulk:
Change Type in Bulk button calls the ChangeTypeByDoubleClick macro function.
ChangeTypeByDoubleClick function call the Worksheet_BeforeDoubleClick function, which performs double click on every cell selected.
Worksheet_BeforeDoubleClick function changes the cell values alternatively from "B&A" to "B" to "A" to "", whenever you perform double click on the cells.
The ChangeTypeByDoubleClick function throws a Type Mismatch Error, the error occurs in the Worksheet_BeforeDoubleClick function in the line
Elself target.Row > Range (Print_Something_Rg).Row And Len (Trim(target.Offset (, 1) .Value)) > 0 Then
whenever I select continuous cells, but there is no error when I select cells separately / only select 1 cell.
Variables in my code
Print_Something_Rg is a defined range, referring to the cell to the right of Type in the picture, you can consider Print_Something_Rg as the start of different product codes.
target is the cells we selected (if you refer to the picture you can see cells being selected)
Example of selecting cells separately:
Example of selecting continuous cells:
My code
Sub ChangeTypeByDoubleClick()
Call Sheet5. Worksheet_BeforeDoubleClick (Selection, False)
End Sub
Public Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
Dim rg_block As Range
If target.Column = Range(Print_Something_Rg).Offset(, -1).Column And Len(Trim (Range(Print_Something_Rg).Offset(1).Value)) > 0 Then
Cancel = TRUE
If target.Row = Range(Print_Something_Rg).Row Then
If Len (Trim(target.Offset(1, 1).Value)) > 0 Then
Set rg_block = Range (target.Offset (1, 1), target.Offset (1, 1) . End (xlDown)).Offset(, -1)
If target.Offset (1).Value = "" Then
rg_block.Value = "B & A"
Elself target.Offset (1).Value = "B & A" Then
rg_block.Value = "B"
Elself target.Offset(1).Value = "B" Then
rg_block.Value = "A"
Else
rg_block.Value = ""
End If
End If
Elself target.Row > Range (Print_Something_Rg).Row And Len (Trim(target.Offset (, 1) .Value)) > 0 Then
If target.Value = "" Then
target.Value =
"B & A"
Elself target.Value = "B & A" Then
target.Value = "B"
Elself target.Value = "B" Then
target.Value = "A"
Else
target.Value = ""
End If
End If
End If
End Sub
I am not exactly sure why would my code break when I select continuous cells, because the Selection should be a range already (so it shouldn't be wrong).
I have double checked the type of my code, and the type should be assigned properly. Considering it only breaks when I select continuous cells, my guess is that it has something to do with it - but I could not figure out why.
Any help would be greatly appreciated, thanks in advance.
When Target is a multi-cell range, its .Value is a 2D array, which you can't call Trim or Len on.
Normally this situation wouldn't even arise since you can only double-click a single cell, but obviously your case is different.
Add a loop to ChangeTypeByDoubleClick():
Sub ChangeTypeByDoubleClick()
If Not TypeOf Selection Is Range Then Exit Sub
Dim cell As Range
For Each cell in Selection
Sheet5.Worksheet_BeforeDoubleClick cell, False
Next
End Sub
As noted in the comments though, it would be much better to move the procedure into a standard module, and call that procedure within the Worksheet_BeforeDoubleClick handler.
I am trying to make a visualized way of seeing an inventory list. There are around 200 items and I am trying to format the diagrams to show green if we have a surplus of the item, yellow if we only have one set and red if we are out of stock. This is my first project with VBA and gleaned what I could from Google results. This is what I have so far, where I have the first item (it's a shape on the diagram named "1". Cell C2 is formatted to show either "Order", "1 Set" or "In Stock" based on another cell's value for the actual number on hand.
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Shapes("1").Fill.ForeColor.RGB = vbWhite
If ActiveSheet.Range("C2") = "1 Set" Then
ActiveSheet.Shapes("1").Fill.ForeColor.RGB = vbYellow
ActiveSheet.Shapes("1").Fill.Transparency = 0.75
End If
If ActiveSheet.Range("C2") = "In Stock" Then
ActiveSheet.Shapes("1").Fill.ForeColor.RGB = vbGreen
ActiveSheet.Shapes("1").Fill.Transparency = 0.75
End If
If ActiveSheet.Range("C2") = "Order" Then
ActiveSheet.Shapes("1").Fill.ForeColor.RGB = vbRed
ActiveSheet.Shapes("1").Fill.Transparency = 0.75
End If
And it just goes on from there. It was working perfectly for me until I got about halfway through and began getting errors for its size. So is there a way to have a main function system that can look at each of the items and apply it to the respective shape? Or, is there a way to break it into sections so each sub is smaller, but still behaves as a single process? Thank You!
Something like this should work
Private Sub Worksheet_Change(ByVal Target As Range)
Dim clr as long, c As Range
'Me is the sheet with this code
For Each c in Me.Range("C2:C100").Cells 'for example
Select Case c.Value
Case "1 Set": clr = vbYellow
Case "In Stock": clr = vbGreen
Case "Order": clr = vbRed
Case Else: clr = vbWhite
End Select
Me.Shapes(CStr(c.Row-1)).Fill.ForeColor.RGB = clr
Next c
End sub
how can I make the double click works ONLY when column 1,2,3 and 4 have values? I don't know where I should insert the code.. it's something like if column 1,2,3 and 4 have values then doubleclick.enable = TRUE else doubleclick.enable= FALSE..
Kindly need advice. My code is as follows:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Select Case Target.Column
Case 6, 13
If Not Intersect(Target, Range("F2:F13, M2:M13")) Is Nothing Then Cancel = True
Target.Font.Name = "Times New Roman"
If Target = "" Then
Target = ChrW(&H2713)
Else
MsgBox "You cannot modify the cell."
End If
End Select
End Sub
I am asking just to clarify the issue.
You only want to call doubleclick procedure if any cell in column 1 to 4 have value
Or you want to check if corresponding row has value?
for option 1, you may use
If Application.CountA(Range("A1:D" & Rows.Count)) > 0 Then
'Your Code
End If
for second option
If Application.CountA(Range("A" & target.Row & ":D" & target.Row)) > 0 Then
'Your Code
End If
I tested above codes but in case of any mistake, we can modify them
I'm looking for a way for excel to alert me when a dynamic value (market feed data) is out of line by x%. The alert needs to appear in front of all my windows with a msg box "CHECK VALUES".
Is this possible to do and has anyone have an example of code for this?
More specifically
Minimum difference = 0.5
CELL A = 10
CELL B = 11
Difference = 1
ALERT user "Difference > 0.5"
Thank you in advance.
Thank you. This works perfect. Now I understand how it works, I'm hoping for another solution similar to the above. Both cells in A1 and B1 are constantly changing(variables). Cell C1 is the =ABS(B1-A1). What I need now is a code to alert me when Cell C1 is greater than 0.5.
You can use worksheet_change event. Try below code.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo err_rout
Application.EnableEvents = False
If Target.Address = "$A$1" And Target.CountLarge = 1 Then
If (Target.Value - Target.Offset(0, 1)) > 0.5 Then
MsgBox "CHECK VALUES"
End If
ElseIf Target.Address = "$B$1" And Target.CountLarge = 1 Then
If (Target.Value - Target.Offset(0, -1)) > 0.5 Then
MsgBox "CHECK VALUES"
End If
End If
err_rout:
Application.EnableEvents = True
End Sub
Ok I have a worksheet "Goal 0" that with some ranges, make some calculations like...
(in A1)
=SUM(G2:G68)*I17
Then if I add/modify any of the values in 62-G68, the cell is auto calculated (numbers that are mainly negative and some possitive).
The objetive is: According to the sum of the range, find the value of I17 where the result of A1 is equal or more than 0. (Starting from 0, incrementing it 1 by 1, decimals not needed)
Manually I can add change i17 untill it reaches the goal. How ever I want to make it automatically, so if a value in the range of G2 to G68 changes it recalculate the value of I17, untill (A1 calculation gets value equal or higher than 0) but if already is higger or equal than 0 then do nothing.
Hope I explain it well
EDIT: Now I created this code ...
Function IncreaseTheValue()
If Range("A1") < 0 Then
Range("I17").Value = 0
Do While Range("A1").Value < 0
Range("I17").Value = Range("I17").Value + 1
Loop
End If
End Function
And works perfect, how ever it does not fires when I make a chage. How do I do that...
I try adding this in A2 cell but did not worked ...
=IF(A1 < 0, IncreaseTheValue(), "")
Regards
You shouldn't really be doing this as a Function; it is inadequate as you notice, but also not appropriate use of a Function where a Sub or event handler is more appropriate.
Based on your requirements, put the code in the Worksheet_Change event handler. You will need to fine-tune it so that it only fires when a change is made in the range G2:G68.
Try this (untested):
Private Sub Worksheet_Change(ByVal Target as Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("G2:G68")) Is Nothing Then
If Range("A1") < 0 Then
Range("I17").Value = 0
Do While Range("A1").Value < 0
Range("I17").Value = Range("I17").Value + 1
Loop
End If
End If
Application.EnableEvents = True
End Sub
Updated per pnuts comments. This method below will trigger the macro any time any cell changes -- this might be overkill, or it might be necessary if G2:G68 is formulas which change based on changes to other cells. Either method can be fine-tuned to better suit your exact needs.
Private Sub Worksheet_Change(ByVal Target as Range)
Application.EnableEvents = False
If Range("A1") < 0 Then
Range("I17").Value = 0
Do While Range("A1").Value < 0
Range("I17").Value = Range("I17").Value + 1
Loop
End If
Application.EnableEvents = True
End Sub