This seems rather an easy task, but somehow nothing has worked since I have tried several solutions to now...
I want something, supposing we have this sheet:
When a Cell is Clicked randomly, the value/contents of that text should be shown in the Orange Box.
That's the first and most important part.
The second thing to happen is:
if possible, all other Cells that contain the same value should be highlighted/shaded with an Green Background (See image)
I have tried:
https://www.ablebits.com/office-addins-blog/2015/02/10/excel-indirect-function/
http://www.contextures.com/xlFunctions05.html
https://support.office.com/en-us/article/Hide-or-display-cell-values-c94b3493-7762-4a53-8461-fb5cd9f05c33
https://support.office.com/en-us/article/CELL-function-51bd39a5-f338-4dbe-a33f-955d67c2b2cf
Thank you in advance.
EDIT 1: PS: Preferably a Non-VB solution. However, if a VB solution would be all there is, then your VB suggestions would be highly appreciated
Most of this is answered here so it just needs editing a bit
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
'Put in your actual range and the cell where you the text to be shown
If Not Intersect(Target, Range("B5:D17")) Is Nothing Then
Selection.Copy Destination:=Range("E2")
End If
End If
End Sub
and the colouring can just be done with a conditional formatting rule
=B5=$E$2
assuming that the values start in B5 and the text to be displayed is in E2.
If you only want to copy the value and not the formatting to E2, replace
Selection.Copy Destination:=Range("E2")
with
Range("E2").Value = Selection.Value
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Task1: Show your active cell contents in cell E2
actval = ActiveCell.Value
actaddr = ActiveCell.Address
Range("E2") = actval
'Task2: Turn all cells green, matching with active cell value, except host cell
'first set entire background white
Range("B5:F18").Interior.Color = vbWhite
'second set all matching cells green
For Each c In Range("B5:F18")
If c.Address <> actaddr Then
If c = actval Then
Range(c.Address).Interior.Color = vbGreen
End If
End If
Next c
End Sub
Related
First attempt got closed as duplicate and I've used the suggested thread (VBA code doesn't run when cell is changed by a formula) & I've done some changes, but it still isn't working nothing happens.
I would like to change the color of a sheet tab based on the value of a cell (that has a formula in it) in a different sheet, but same workbook. The Different Sheet is the Master sheet "Test Summaries", and the cell I'd like to refer to is different for each sheet.
What I need:
Tab "Microscopy" to change either color to red/orange/green based on
the formula in Sheet "Test Summaries" cell"C2" (in this case Red) Tab
"Culture" to change either color to red/orange/green based on the
formula in Sheet "Test Summaries" cell "C3" (in this case Red)
...and so on
In the picture you'll see that I've got a formula that tells me what color the tab should be based on specific testing criteria. I've tried the following code, but it won't change the color of the tab unless the cell contains text and the macro only allows me to refer to one cell.
My updated code that is in the Sheet "Microscopy" object.
Private Sub Worksheet_Calculate1(ByVal Target As Range)
Dim MyVal$
MyVal = ActiveWorkbook.Sheets("Test Summaries").Range("C2")
With ActiveSheet.Tab
Select Case MyVal
Case "RED"
.Color = vbRed
Case "GREEN"
.Color = vbGreen
Case "AMBER"
.ColorIndex = 45
End Select
End With
End Sub
Private Sub Worksheet_Calculate()
If Range("A1").Value <> PrevVal Then
MsgBox "Value Changed"
PrevVal = Range("A1").Value
End If
End Sub
But this didn't work (nothing happens), so then I added the following based on thread I've made some changes to my code, but nothing happens.
This code into ThisWorkbook Objects (but I don't understand what it's suppose to do, but it doesn't seem right as I need each tab to refer to a different cell)
Private Sub Workbook_Open()
PrevVal = Sheet1.Range("C3").Value
End Sub
Then in the Modules 1 I've put this
Private Sub Workbook_Open()
PrevVal = Sheet1.Range("C3").Value
End Sub
I would really appreciate help.
btw I'm working in excel 2010
Something like the following should do the trick, looping through the list of worksheet names in column A and using Offset to refer to their corresponding formula in column C.
Private Sub Worksheet_Calculate()
Dim rng As Range
For Each rng In Me.Range("A2:A5") ' change as needed
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(rng.Value)
Select Case rng.Offset(, 2).Value
Case "RED"
ws.Tab.Color = vbRed
Case "GREEN"
ws.Tab.Color = vbGreen
Case "AMBER"
ws.Tab.ColorIndex = 45
End Select
Next
End Sub
I'm working on a table where I've inserted some Checkboxes (Form Control) which are linked to cells that return True or False when either Checkbox is ticked.
I wrote a code that should change the cell's color according to the returned value.
The code works fine but only when I double click the cell and validate by pressing Enter, or when I run the Sub by hitting F5 or a clicking a button.
(I used a similar code that updates everything automatically in another project but it doesn't seem to work here)
How can I make the Sub run automatically (or the sheet update) once a checkbox is ticked?
Here is the code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("A2:Q21"), Range(Target.Address)) Is Nothing Then
Dim cell As Range
For Each cell In ActiveWorkbook.Sheets("Sheet1").Range("A2:Q21")
If cell.Value = "True" Then
cell.Interior.Color = vbGreen
ElseIf cell.Value = "False" Then
cell.Interior.Color = vbRed
End If
Next
End Sub
I know I could use conditional formatting but this sheet will expand rapidly and I don't see myself copy-pasting hundreds of checkboxes
As the sheet will expand I think it'll be better to include a "lastRow" statement since I will be adding new rows at the bottom using a UserForm
Thanks!
You should extract the part doing the coloring to a new function and call that from both the original and from the checkbox's event handler.
' In Sheet1 Module
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("A2:Q21"), Range(Target.Address)) Is Nothing Then
ColorCells
End If
End Sub
' In Module1 Module
Sub CheckBox1_Click()
ColorCells
End Sub
Public Sub ColorCells()
Dim cell As Range
For Each cell In ActiveWorkbook.Sheets("Sheet1").Range("A2:Q21")
If cell.Value = "True" Then
cell.Interior.Color = vbGreen
ElseIf cell.Value = "False" Then
cell.Interior.Color = vbRed
End If
Next
End Sub
Update
If there are too many checkboxes than you may use the Worksheet's Calculation event handler assuming that the checkboxes have Linked Cells and some other Cell refers to their value.
' In Sheet1 Module
Private Sub Worksheet_Calculate()
ColorCells
End Sub
Note, if the checkbox does not have a Linked Cell, it won't work. If the checkbox has a Linked Cell but it is not referred to by any other cell, it won't work. This is because in these cases no recalculation will be initiated.
You can test this: Assign A1 to a Checkbox (on a new sheet), and try if the macro runs (should not), then write in A2 =2*--A1, and check again, now it should work.
If you want to minimize the footprint of this requirement, find an unused cell on the sheet and enter the following formula: =INDEX(1:1048576,1,1). This refers to all cells but it does not require a lengthy calculation. Of course, if you want to place it into A1, you should change the ,1,1 part to something else to avoid circular references.
Instead of firing your colouring sub at Worksheet_Change, put it under Worksheet_Calculate. Then insert the formula =A1:Q21(or whatever you need to cover your range) somewhere in your sheet. It will resolve to #value but that isn't important. This formula will force your sheet to automatically recalculate when anything within its range is changed, including the cells linked to your checkboxes. And then upon recalculate it will fire the sub that colours your cells correctly.
I have a Excel File, I need to insert an scanned barcode into selected cell and after that I need to select the next cell no the below cell. For example:
Current selected cell = A1, Barcode scanned and inserted. Current selected cell now should be B1 instead A2.
I tried adding a textbox and works fine but I found a problem. If my barcode is for example 20010 my code split one number and inserts in one cell. So instead of having in A1 20010 I have 2, in B1 0, in C1 0 in D1 1 and in E1 0.
This is my code:
Private Sub TextBox1_Change()
If Len(TextBox1.Value) > 0 Then
ActiveCell.Value = TextBox1.Value
ActiveCell.Offset(0, 1).Activate
TextBox1.Value = ""
TextBox1.Activate
End If
End Sub
PD. I don’t know the barcode length. Never it’s gonna by the same.
How can I solve my problem?
Scanners are usually programmable to enter either a carriage return or a tab after it scans, but if you're dead set on using VBA to accomplish this, you could get rid of your textbox and use this in the Worksheet code of the sheet you're scanning into:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Row = 1 Then
ActiveCell.Offset(-1, 1).Select
End If
End Sub
If you want it to move from Column A to B to C regardless of row number then change the above to
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
ActiveCell.Offset(-1, 1).Select
End Sub
I am looking for a script that will pull data from last edited cell into Cell B1 of active sheet and also look up data from cell in column A and then display it in cell A1.
So far I've got this to pull last edited cell into B1 and it works fine but I cannot figure out how to then go back from that point to row A and display the other info.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("F13:W9910")) Is Nothing Then
ActiveSheet.Range("B1").Value = Target.Value
End If
End Sub
In the attached picture if I add any numbers in section called trays completed (in red) to display in B1 and then look up number in Sap column and display the number in cell A1
Something like this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("F13:W9910")) Is Nothing Then
Me.Range("B1").Value = Target.Value
Me.Range("A1").Value = Target.Entirerow.Cells(1).Value
End If
End Sub
Note when in a sheet code module you can refer to the worksheet using Me
Also be aware that Target might be >1 cell and your code might need to handle that.
This will take the corresponding value in A and place it in A1. I only added one line of code to yours.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("F13:W9910")) Is Nothing
Then
ActiveSheet.Range("B1").Value = Target.Value
ActiveSheet.Range("A1").Value = ActiveSheet.Range("A" & Target.Row)
End If
End Sub
I have a worksheet which contains a list of tasks, one on each row. Column A is the task name, column B is the date when it must be done and Column C is the person who must do it. Column D is used to indicate when it's been done. If this column contains anything, then the background colour for whole row should be grey, otherwise it should be white.
I'm thinking the worksheet_change event is the best way to handle this. I suppose I could use Conditional Formatting, but that seems to be vulnerable to breaking if cells get dragged around - I need this to be as "bullet-proof" as possible!
In pseudo-code, I'm trying to achieve the following:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target includes a cell in column "D"
If "D" is not empty
Set entire row background to grey
Else
Set entire row background to white
End If
End If
End Sub
Can anybody give me any pointers about the best way to implement this? Am I even on the right lines, or is there a better way?
I think you can use the following condition on every cell:
=INDIRECT("$D" & ROW())>0
I did some copy/pastes and dragged the cells around, and the conditional format did not break.
With Conditional Formatting:
Go to Tools->Options->General and activate the R1C1 reference style
Condition: =ISEMPTY(RC4)
With VBA:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim found As Range
Dim cell As Range
Dim colStart As Integer
Dim colEnd As Integer
Set found = Intersect(Target, Me.Columns(4))
colStart = 1
colEnd = 4
If Not found Is Nothing Then
For Each cell In found
With Me.Range(Me.Cells(cell.Row, colStart), Me.Cells(cell.Row, colEnd)).Interior
If IsEmpty(cell) Then
.ColorIndex = 15
Else
.ColorIndex = xlNone
End If
End With
Next cell
End If
Set found = Nothing
End Sub
I recommend using Conditional Formatting