In sheet1 (which I've Called "MainSheet") I have a sub in my VBA script that check the values of some cells whenever a cell is changed in this sheet. (one of the main actions that will occur when a cell is changed is modifying it's color, green for Cell's with a value, red for empty cells)
But now I've got some other sub's that also change cells (in the main sheet) but in this case I don't need (and don't want) VBA to check the cells and adapt the color to their values after every cell change. (annoying when editing a large amount of cells).
(I've already tried to put this sub in the "ThisWorkbook"part of VBA instead of the Sheet1(MainSheet) part, but unfortunately this made no difference at all).
Question one: is it possible to prevent this?
I also have a correlated problem with another sub that worth mentioning in the same question I think: In this sub a new sheet is created, named and filled with text from a .txt document. Then the sheet will be saved as new workbook, and the sheet will be deleted. (The name of the sheet equals the name it will get when it's saved, and varies ever new occurrence.)
When I'm copying the .txt lines into this sheet one by one, the first sub I mentioned (the one editing cell color) is called. one of the first things happening in this sub is calling my MainSheet. When thin sub is finished the line copying sub will continue but will start pasting the lines in my Main Sheet. I tried to enter lines in this sub that select the sheet with variable name, but it keeps jumping to the MainSheet.
Question two: How do I prevent jumping to the MainSheet?
(Both questions probably could have the same solution.)
The sub that modifies the cell colours:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Integer
'Collor all cells green containing values, collor empty cells red.
''Starts automaticly after every cell change within this sheet
'Huidige Cell onthouden
If Not Intersect(Target, Range("A9:A29")) Is Nothing Then
On Error GoTo bm_Safe_Exit3
Application.EnableEvents = False
If Intersect(Target, Range("A9:A29")).Cells.Count > 1 Then
Application.Undo
MsgBox "Please edit one cell at a time!"
Else
Dim newVal3 As Variant
newVal3 = Target.Value
Range("A9:A29").ClearContents
Target.Value = newVal3
End If
End If
bm_Safe_Exit3:
Application.EnableEvents = True
Set myActiveCell = ActiveCell
Set myActiveWorksheet = ActiveSheet
Set myActiveWorkbook = ActiveWorkbook
Sheets("MainSheet").Select
Range("C5").Select
j = 0
Do While j < 6
If ActiveCell.Offset(0, j).Value = "" Then
ActiveCell.Offset(-1, j).Interior.Color = RGB(255, 0, 0)
Else: ActiveCell.Offset(-1, j).Interior.Color = RGB(0, 255, 0)
End If
j = j + 1
Loop
'Terug naar de voormalig active cell
myActiveWorkbook.Activate
myActiveWorksheet.Activate
myActiveCell.Activate
End Sub
Using .Select and .Activate is inefficient at the best of times; in a Worksheet_Change event macro it can really foul the waters.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
If Not Intersect(Target, Range("A9:A29")) Is Nothing Then
If Intersect(Target, Range("A9:A29")).Cells.Count > 1 Then
Application.Undo
MsgBox "Please edit one cell at a time!"
'intentionally throw an error; no more code run; sent to bm_Safe_Exit
Err.Raise 0
Else
Dim newVal3 As Variant
newVal3 = Intersect(Target, Range("A9:A29")).Cells(1).Value
Range("A9:A29").ClearContents
Intersect(Target, Range("A9:A29")).Cells(1) = newVal3
End If
End If
Dim j As Integer
With Worksheets("MainSheet").Range("C5")
For j = 0 To 6
If Not CBool(Len(.Offset(0, j).Value)) Then
.Offset(-1, j).Interior.Color = RGB(255, 0, 0)
Else
.Offset(-1, j).Interior.Color = RGB(0, 255, 0)
End If
Next j
End With
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
It isn't clear exactly what worksheet this is running under; I hope it isn't the MainSheet as I've used direct referencing to the cells on that worksheet.
See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.
Related
I have data in column "AK" and a button in Column "AL"; there are several hundred rows and there is only one macro for all buttons as it uses relative references based on the row it is in.
I want the button to only be visible when there is data in the adjacent cell. The following pseudo-code explains what I am trying to achieve:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 37 Then
If Target.Value = 0 Then
Shapes(Target.offset(0, 1)).Visible = False
Else
Shapes(Target.offset(0, 1)).Visible = True
End If
End If
End Sub
The reason for doing this is that the value in AK is calculated based on other values and only displays once all mandatory fields have been completed. The button should only be available for an automation task once all details are complete. What real code would make this work without having to call each button out individually?
I'm not sure if you can directly reference a shape by its location on the sheet.
This code will look at each shape until it finds the one to the right of the cell you've just changed, it will then change the visibility based on the contents of the cell.
(Target.Value <> "") returns TRUE/FALSE.
This will only work if your buttons are placed in the correct cell (slightly too high and it will return the cell above).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim shp As Shape
For Each shp In ThisWorkbook.Worksheets("Sheet1").Shapes
If shp.TopLeftCell.Address = Target.Offset(, 1).Address Then
shp.Visible = (Target.Value <> "")
Exit For 'Exit the loop - the correct button has been found.
End If
Next shp
End Sub
Edit:
I've updated the code so it checks that only a single cell has been changed and then looks at each dependent cell of the cell that was changed.
This will probably muck up if the dependent cell is on another sheet though.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rUpdated As Range
Dim shp As Shape
Dim rCell As Range
If Target.Cells.Count = 1 Then
'Hopefully someone will have better code than On Error....
On Error Resume Next
Set rUpdated = Range(Target.Dependents.Address)
On Error GoTo 0
If Not rUpdated Is Nothing Then
'Look at each dependent cell in rUpdated.
For Each rCell In rUpdated
'Look at each shape in the sheet and cross-reference with rCell.
For Each shp In Target.Parent.Shapes
If shp.TopLeftCell.Address = rCell.Offset(, 1).Address Then
shp.Visible = (Target.Value = 0)
Exit For 'Exit the loop - the correct button has been found.
End If
Next shp
Next rCell
End If
End If
End Sub
NB: I got the idea for checking the dependent cell from here: How can I run a VBA code each time a cell get is value changed by a formula?
Hi there i have this code which changes cells with reference errors to white fonts. However i could only do so for a single sheet. range. How do i change the for each loop to loop for all the worksheets in the workbook? I used this code below but it does not seem to work!
Sub Delete_ref_basedontextcondition()
Dim R As Range
'Set rng = Nothing
On Error Resume Next
Set R = Application.InputBox("Select cells To be deleted", Type:=8)
Dim rng As Range
If TypeName(R) <> "Range" Then
Exit Sub
Else
R.Delete
End If
For k = 1 To ThisWorkbook.Worksheets.Count 'runs through all worksheets
Set wks = ThisWorkbook.Worksheets(k)
For Each cell In wks
If cell.Text = "#REF!" Then
cell.Font.Color = RGB(255, 255, 255)
End If
Next
Next
End Sub
While I disagree with your method of hiding #REF! errors rather than dealing with them so that they are not #REF! errors (or deleting the formulas that are creating them, here is some standard 'loop-through-the-worksheets' code that you should be able to adapt for your purposes.
Sub bad_ref()
Dim w As Long, ref As Range
On Error Resume Next
For w = 1 To Worksheets.Count
With Worksheets(w)
For Each ref In .Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
If ref.Text = "#REF!" Then
ref.Font.ColorIndex = 2
'ref.clear '<~~this clears formatting, formulas. etc from the rogue cell.
End If
Next ref
End With
Next w
End Sub
It should run through quickly enough. Rather than examine every cell on each worksheet, I've narrowed down the cells to be critiqued with the Range.SpecialCells method, looking only through the formulas that produce errors. Something like a #N/A error will be left alone.
I've left an option to actually do something with the errors as a commented line.
I have a macro that puts the current time into a cell upon editing any row. my problem is that this macro also executes for row 1 which are the titles. So it ends up changing the title of a column to a time.
The macro works fine but still changes the title. I tried the following:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If ActiveCell.Row = 1 Then Exit Sub
Cells(Target.Row, "I").Value = Now
Application.EnableEvents = True
End Sub
The ActiveCell can change to something else after you edit, so use the Target range rather than the ActiveCell. For example, if I hit {enter} to finish my edit, the ActiveCell is now on row 2 rather than 1.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target
If .Row > 1 Then
Cells(.Row, "I").Value = Now
End If
End With
Application.EnableEvents = True
End Sub
I'm using With syntax to show the same Row you are comparing is the one you are editing. You could still put these on separate lines if you wish.
Also, user Jeeped makes a good point about the Application.EnableEvents = True line. It won't run if the row is 1, so they get turned off indefinitely. Better to test for > 1 and only run your update code on that condition.
If you turn off event handling, provide error control that makes sure that events will be re-enabled.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim r As Long, rw As Long, rng As Range, newTarget As Range
For Each rng In Target
If rng.Column <> 9 Then
If newTarget Is Nothing Then
Set newTarget = rng
Else
Set newTarget = Union(newTarget, rng)
End If
End If
Next rng
For r = 1 To newTarget.Rows.Count
rw = newTarget.Rows(r).Row
If rw > 1 Then _
Cells(rw, "I").Value = Now
Next r
Safe_Exit:
Application.EnableEvents = True
End Sub
If you are pasting or filling a large number of values then Target is all of the cells that changed. You need to guard against the top row while everything else receives the timestamp. When Target is more than a single cell, you only want to timestamp once per row.
And you don't want to turn off event handling then exit without turning it back on again.
I am very new to coding...
Sheet 1 has my data validation in a scroll list on it and sheet 2 has the list that it is validating the data from. I am trying to make a combo box on sheet 1 that will auto fill while you type instead of having to type the exact name. The code below only works if the data list is on the same sheet as the sheet I am trying to make the combo box on. Any idea how to change the code so it will pull from sheet 2 where all the list of data is located?
Any help would be greatly appreciated
'=========================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
On Error GoTo errHandler
If Target.Count > 1 Then GoTo exitHandler
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
If cboTemp.Visible = True Then
With cboTemp
.Top = 10
.Left = 10
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
End If
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains a data validation list
Application.EnableEvents = False
'get the data validation formula
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 5
.ListFillRange = ws.Range(str).Address
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.TempCombo.DropDown
End If
exitHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
errHandler:
Resume exitHandler
End Sub
'====================================
'Optional code to move to next cell if Tab or Enter are pressed
'from code by Ted Lanham
'***NOTE: if KeyDown causes problems, change to KeyUp
Private Sub TempCombo_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
Select Case KeyCode
Case 9 'Tab
ActiveCell.Offset(0, 1).Activate
Case 13 'Enter
ActiveCell.Offset(1, 0).Activate
Case Else
'do nothing
End Select
End Sub
'====================================
You have a lot of code just to populate a Combobox in the active sheet.
Since you are using the Worksheet_Change event, you don't have to set the worksheet as the active sheet, it already is.
This sample code will populate ComboBox1 with a range of cells from Sheet2,
The code and Combobox1 are located in Sheet1.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws As Worksheet, Rws As Long, Rng As Range
'ComboBox1 and this code are in Sheet1
Set ws = Sheets("Sheet2") 'sheet2 column 1 is the list to populate Combobox1
With ws 'set the list range
Rws = .Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = .Range(.Cells(1, 1), .Cells(Rws, 1))
End With
With ComboBox1 'populate the combobox
.Clear
.List = Rng.Value
End With
End Sub
If you can forgo the need to have Excel autocomplete based on a user's entry, you can use the cell validation as demonstrated here (backward compatible with older versions):
Dependent Drop-down Lists
Or here (for newer versions):
Insert or delete a drop-down list
The upside to this is that it requires no code, unless you would like to manipulate the list automatically.
Using a combobox object is definitely more complicated, so you might skip on that until your coding catches up to the complexity required by objects.
==EDIT==
OK, then, 2 things: this code (Private Sub Worksheet_SelectionChange(ByVal Target As Range)) applies every time you click a new cell. If your values don't change very much you can make sure the cbo only populates on workbook_open, or something less active. However, if the combobox source data changes frequently while the workbook is open then having a frequent refresh to the source would be worthwhile.
Try naming the range you want the combobox to get its data from and pointing the ListFillRange to that named range, like:
.ListFillRange = "myNamedRange"
Then, if your source grows or shrinks, incorporate code that redefines the named range based on the changes.
I would like to start off with stating that I have virtually no coding experience. I found a VBA snippet online for highlighting an entire selected range (just to as a visual guide):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
' Clear the color of all the cells
Cells.Interior.ColorIndex = 0
With Target
' Highlight the entire column that contain the active cell
.EntireRow.Interior.ColorIndex = 8
End With
Application.ScreenUpdating = True
End Sub
I would like to also have the cursor jump-to column "J". For instance, after performing a search for cells containing the words "strawberry topping" after pressing 'OK' the cell containing that text becomes active and, due to the VBA code, the entire row is highlighted.
The first cell I need to work on is in column "J". Can I also have column J selected along with the row being highlighted?
Thank you so much for your time and would appreciate any help you may have to offer.
My Three cents
If you are using xl2007+ then do not use Target.Cells.Count. Use Target.Cells.CountLarge else you will get an Overflow error if a user tries to select all cells by pressing CTRL + A as Target.Cells.Count can't hold a Long value.
If you want to select the row and the column, you might want to switch off events else you might end up in endless loop.
Since you are working with events, use error handling.
Is this what you are trying?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rw As Long, Col As Long
Dim ColName As String
On Error GoTo Whoa
If Target.Cells.CountLarge > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
' Clear the color of all the cells
'Cells.Interior.ColorIndex = 0
With Target
Rw = .Row
Col = .Column
ColName = Split(Cells(, Col).Address, "$")(1)
' Highlight the entire column that contain the active cell
'.EntireRow.Interior.ColorIndex = 8
Range(ColName & ":" & ColName & "," & Rw & ":" & Rw).Select
End With
LetsContinue:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
End Sub