This one has driven me mad so hopefully one of you can tell me what I'm doing wrong.
All I want to do is if any cell in column I contains the value "Y" then column J gets hidden. If you then delete the Y from any cell then column J appears again.
Here's my code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("I:I")
Set cell = rng.Find(What:="Y")
If cell Is Nothing Then
Columns("J").EntireColumn.Hidden = True
Else
Columns("J").EntireColumn.Hidden = False
End If
End Sub
Basically the code does absolutely nothing. Which annoys me more than getting an error, because I have no clue what I've done wrong.
Try the following...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Columns("I:I").Select
Set cell = Selection.Find(What:="Y", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If cell Is Nothing Then
Columns("J").EntireColumn.Hidden = False
Else
Columns("J").EntireColumn.Hidden = True
End If
End Sub
This is something that works:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Target.Column = 9 Then
With Range("I:I")
Set c = .Find("Y")
If Not c Is Nothing Then
Columns("J").EntireColumn.Hidden = True
Else
Columns("J").EntireColumn.Hidden = False
End If
End With
End If
End Sub
In order to make sure that it works, put your code in the corresponding sheet,not in the module
Make sure that macros are enabled
Firstly, you can keep this VBA really simple if you have a cell in your workbook which tests if there are any Y in column I. I put the following into cell A1
=COUNTIF(I:I,"Y")
I advise putting this on the worksheet because Excel is smart and will perform this calculation quicker than VBA - it also gives you some sight of what's going on.
We can now use the value of A1 to determine whether to hide column J in the macro
Firstly, it's probably a good idea to test if column J is in the correct state when you open the workbook so put the following code into the ThisWorkbook module. This code is optional
Sub Workbook_Open()
With Me.Worksheets("Sheet1")
If .Range("A1").Value > 0 Then
.Range("J:J").EntireColumn.Hidden = True
Else:
.Range("J:J").EntireColumn.Hidden = False
End If
End With
End Sub
Then to monitor any changes to values in column I, place the following code into your worksheet module
Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("I:I")) Is Nothing Then
If Me.Range("A1") > 0 Then
Me.Range("J:J").EntireColumn.Hidden = True
Else
Me.Range("J:J").EntireColumn.Hidden = False
End If
End If
End Sub
Note: this code is not designed for the user changing multiple cells at once, which shouldn't be a problem if you intend to use it as described. If you wish to paste over multiple cells (for example) at a time, then this will need to be adapted slightly.
Private Sub Worksheet_Change(ByVal Target As Range)
Columns("J").EntireColumn.Hidden = WorksheetFunction.CountIf(Columns("I"),"Y") >0
End Sub
Or
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("I")) Is Nothing Then Columns("J").EntireColumn.Hidden = WorksheetFunction.CountIf(Columns("I"),"Y") >0
End Sub
Related
I'm new to VBA so I'm probably making some beginner mistakes, please bare with me.
Here is the summary of my goal : I have several sheets in an Excel Workbook with the same structure. In each of those, I have a "Project Status" column with numbers ranging from 0 to 12. I'm trying to monitor a change in the column and, if the value of a cell changes, the row gets moved to the corresponding sheet and location.
My problem is that my code works but leaves an empty row where the row was cut. I tried adding
Target.EntireRow.Delete
but, if I add it before Insert the inserted row is empty, if I add it after it doesn't seem to do anything.
Here is a shorter version of my code, that I have in every sheet that is concerned by it :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A:A")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.ScreenUpdating = False
If Target.Value = 0 Then
Target.EntireRow.Cut
IdeasUpcoming.Range("4:4").Insert
End If
If Target.Value = 1 Then
Target.EntireRow.Cut
IdeasUpcoming.Range("4:4").Insert
End If
If Target.Value = 2 Then
Target.EntireRow.Cut
Current.Range("STATUSNewProjects").Offset(1, 0).Insert
End If
If Target.Value = 3 Then
Target.EntireRow.Cut
Current.Range("STATUSAdvancedProjects").Offset(1, 0).Insert
End If
If Target.Value = 4 Then
Target.EntireRow.Cut
Completed.Range("STATUSFinished").Offset(1, 0).Insert
End If
If Target.Value = 5 Then
Target.EntireRow.Cut
Completed.Range("STATUSOld").Offset(1, 0).Insert
End If
End If
bm_Safe_Exit:
Application.ScreenUpdating = True
End Sub
How can I delete the row I'm cutting? I'm sure the If / End If for each cell value aren't optimal, is there a way to simplify this (considering this is shortened, in reality I have 13 values)?
Thank you a lot for your help.
You can use the range.copy logic like this - then you can delete the row afterwards:
With Target.EntireRow
.Copy IdeasUpcoming.cells(4,1)
.Delete xlShiftUp
End With
Regarding your multiple checks:
Maybe you can create a configuration array, which holds per index the target sheets range after that the row should be inserted
Dim arrTarget(1 to 15) as range
set arrTarget(1) = IdeasUpcoming.Cells(4,1)
...
set arrTarget(4) = Completed.Range("STATUSFinished")
Then you can use it like this - without Ifs:
'insert new row for row to be copied
arrTarget(Target.value).Offset(1).EntireRow.Insert xlShiftDown
With Target.EntireRow
.Copy arrTarget(Target.value).Offset(1)
.Delete xlShiftUp
End With
Furthermore you should have one generic copy routine in a normal module
Public sub moveRows(Target as range)
'define arrTarget
'do the copying
End sub
And then you call this generic routine from either all worksheet_change routines
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A:A")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
moveRows target '-- this is where you call the generic sub
end if
End Sub
Or - if you have a sheetname logic to identify the relevant worksheets, e.g. data1, data2 etc. then you could use the workbook_SheetChange event (in the ThisWorkbook-module)
```vba
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name Like "data*" Then
Dim KeyCells As Range
Set KeyCells = Range("A:A")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
moveRows Target '-- this is where you call the generic sub
End If
End If
End Sub
In case you have to make changes to your move-routine or the worksheet_change event, you only have to make changes in one place :-). (DRY: Don't repeat yourself)
I need help automatically changing cells containing a certain value whenever a specific cell on same row changes value.
E.g whenever a cell in B column changes = change TRUE to FALSE on that specific row.
My VBA knowledge is pretty much nonexistent and Im certainly a beginner.
Im fairly sure that Worksheet.Change is what Im looking for and I've been trying out some code I've found here on SO, such as:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Target.Parent.Range("B:B")) Is Nothing Then Exit Sub
For Each x In Target
Cells(x.Row, 3).Value = "False"
Next
End Sub
I know though that this doesn't replace specific values in whatever column the cells are.
I've been trying out silly things like:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Target.Parent.Range("B:B")) Is Nothing Then Exit Sub
For Each x In Target
If Cells(x.Row, x.Column).Value = "TRUE" Then Value = "FALSE"
Next
End Sub
But of course it doesnt work.
Think you could point me out a direction of what I should be researching?
Replace the change event sub on the sheet where you have your data with the code below. I think that should do the trick
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oRng As Range
Dim oCell As Range
' Check if change was in column B
If Intersect(Target, Target.Parent.Range("B:B")) Is Nothing Then Exit Sub
' Turn off events so that when we make a change on the sheet, this event is not triggered again
Application.EnableEvents = False
' Set the range to include all column in Target row
Set oRng = Target.Parent.Range("C" & Target.Row & ":" & Target.Parent.Cells(Target.Row, Target.Parent.UsedRange.Columns.Count).Address)
' Loop through all cells to change the value
For Each oCell In oRng
If Trim(LCase(oCell.Value)) = "true" Then
oCell.Value = "FALSE"
End If
Next
' Enable events again
Application.EnableEvents = True
End Sub
New user, was referred to your helpful website by a friendly team member.
Problem: Trying to force a user in excel to fill in a cell in a column (column O) before filling in a cell in columns I-L. The problem lies in that not every cell in the columns needs to be filled in. I've found a VBA code that has somewhat helped but the problem is the pop up will still occur if column O is filled before there is text in just one of the cells in column I-L (and therefore the error occurs unless all 4 cells in the row are filled in). As mentioned, the goal is (for example) to get O264 to be filled in first before any of the cells in column I,J,K or L264 are filled in.
Further exacerbating this issue is there are multiple rows I need this applied to, believe this is where the range fits in. However, playing with the range line in excel does not work in the way I've tried.
Code below:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I:L")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Offset(, -1).Value = "" Then
MsgBox "You must first enter feedback in column ""O"""
Target.Value = ""
Target.Offset(, -1).Select
End If
End If
End Sub
This could be a case where you might need to aid the user a little more. You could do that by hiding the dependent cells, by locking them, by greying them out, etc. My feeling is that displaying a message box whenever a user enters data in the wrong order is a little too reactive.
In the example below, the target cells are locked and greyed until something is entered in column 'O'. You'd also need to create a list of target rows if you have more than one.
In your code behind the appropriate sheet, the skeleton code below should get you started. I've included a couple of helper functions to make the code a little clearer for you:
Option Explicit
Private Const SHEET_PASSWORD As String = "xyz" 'whatever password you choose.
Private Const TARGET_ROWS As String = "2,4,6" 'your target rows, separated by commas.
Private Const TARGET_COLUMN As String = "O"
Private Const DEPENDENT_COLUMNS As String = "I:L"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell As Range
Set rng = Intersect(Target, Me.Columns(TARGET_COLUMN))
'Exit routine if we're not in the target column.
If rng Is Nothing Then Exit Sub
'Process the target column cells.
For Each cell In rng.Cells
If IsTargetRow(cell.Row) Then
SetDependentStates cell
End If
Next
End Sub
Private Sub SetDependentStates(cell As Range)
Dim DependentRange As Range
'Define the Dependent range based on passed cell row.
Set DependentRange = Intersect( _
cell.EntireRow, _
Me.Range(DEPENDENT_COLUMNS) _
)
'Lock/unlock and paint Dependent rows, based on
'contents of passed cell.
Application.EnableEvents = False 'prevent capture of change event.
Me.Unprotect SHEET_PASSWORD
With DependentRange.Cells
If Len(cell.Value) = 0 Then
.ClearContents
.Locked = True
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Else
.Locked = False
With .Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End With
Me.Protect SHEET_PASSWORD
Me.EnableSelection = xlUnlockedCells
Application.EnableEvents = True
End Sub
Private Function IsTargetRow(rowNum As Long) As Boolean
Dim v As Variant
'Tests if the pass row number is in the target row list.
For Each v In Split(TARGET_ROWS, ",")
If CLng(v) = rowNum Then
IsTargetRow = True
Exit Function
End If
Next
End Function
Public Sub InitialiseDependentStates()
Dim v As Variant
Dim cell As Range
'Define your unlocked cells.
'This is a simple example, adjust as you wish.
With Me
.Unprotect SHEET_PASSWORD
.Cells.Locked = False
.Protect SHEET_PASSWORD
.EnableSelection = xlUnlockedCells
End With
For Each v In Split(TARGET_ROWS, ",")
Set cell = Me.Range(TARGET_COLUMN & v)
SetDependentStates cell
Next
End Sub
You'll likely want to initialise the dependent states when the workbook is opened. Do this in the code behind the Workbook:
Private Sub Workbook_Open()
Sheet1.InitialiseDependentStates 'use whichever sheet you're using.
End Sub
I have a working macro that hides/unhides specific columns based off specific values in Column B. I also want to add another trigger that takes the user to the most recently used row. Below is my attempt.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
On Error GoTo safe_exit
Application.EnableEvents = False
Dim t As Range
For Each t In Intersect(Target, Range("B:B"))
Select Case (t.Value)
Case "A"
Columns("B:BP").EntireColumn.Hidden = False
Columns("H:BL").EntireColumn.Hidden = True
Case "B"
Columns("B:BP").EntireColumn.Hidden = False
Columns("F:G").EntireColumn.Hidden = True
Columns("P:BP").EntireColumn.Hidden = True
End Select
Next t
End If
safe_exit:
Application.EnableEvents = True
'Go to last cell in column B
With ActiveSheet
Range("B5").Select
Selection.End(xlDown).Select
End With
End Sub
Perhaps I misread your question from the other answer - and if so, I will be more than happy to delete this one.
You can simply add a variable that will track this for you and persist as long as you keep Excel open.
Private lastUsedRng As Range
Private Sub Worksheet_Change(ByVal Target As Range)
Set lastUsedRng = Target
. . .
...that takes the user to the most recently used row
You can accomplish this with
lastUsedRng.Select
Use Select as little as possible, and replace the last section starting with 'Go to last cell in column B with something like this, except moving it inside the If...End If.
With Me
.Cells(.Rows.Count, 2).End(xlUp).Select
End With
What I'm trying to do is when a cell (A1) matches something in a named range ("Names") then it changes colour, however if it doesn't but matches something a different named range ("Eye") then it becomes a different colour (there are many more ranges, but I'm sure I'll be able to figure it out after I have two working)
Things to note:
I know this can be done with conditional formatting, however due to the number of named ranges, and sizes of the ranges I was hoping it would be easier using a macro.
I so far have managed to get it working for one named range, and when A1 isn't a formula (however A1 will be)
My 2 lots of code so far are (note this is under sheet1):
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Application.Run ("Colour")
End If
End Sub
The my second one (is being a seperate module):
Sub Colour()
With ActiveSheet
For Each c In .Range("Names").Cells
If c.Value = .Range("A1").Value Then
Range("A1").Select
With Selection.Interior
.Color = 5287936
End With
End If
Next c
End With
End Sub
I think this does what you want:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("A1")) Is Nothing Then
ApplyColor Me.Range("A1")
End If
End Sub
Sub ApplyColor(ValueRange As Range)
Dim MatchRanges As Variant
Dim MatchColors As Variant
Dim MatchValue As Variant
Dim i As Long
MatchRanges = Array("Names", "Eye")
MatchColors = Array(5287936, 4287952)
MatchValue = ValueRange.Value
ValueRange.Interior.Color = vbWhite
For i = LBound(MatchRanges) To UBound(MatchRanges)
If WorksheetFunction.CountIf(Me.Range(MatchRanges(i)), MatchValue) > 0 Then
ValueRange.Interior.Color = MatchColors(i)
Exit For
End If
Next i
End Sub
A couple of notes: "Color" is a VBA reserved word and could cause issues, so I used something else for your sub name. You don't need to use Application.Run in this situation, just the sub's name and its arguments (or Call if you prefer).