Find out if selected cell is in databodyrange - excel

I have a macro set up to perform a chunk of code in an 'onclick' event, and I'm trying to determine if they've selected a numeric value in a table range. An example of my table is below, and I'm trying to figure out if they've selected a number > 0 in the second column. I know how to reference the second column of a specific table, something like:
ListObjects("Table1").ListColumns(2).DataBodyRange
but I'm not sure how to figure out if the selected cell is in that range. Any suggestions? Thanks so much for your help!

Use Intersect.
Dim rangeToCheck as Range
Set rangeToCheck = Intersect(ActiveCell, ListObjects("Table1").ListColumns(2).DataBodyRange)
If Not rangeToCheck Is Nothing Then
If IsNumeric(ActiveCell.Value) Then
If ActiveCell.Value > 0 Then
' do the suff
End If
End If
End If

Assuming your table has filters then you have to check the visible cells only
Try this code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Dim r As Range
Set r = ListObjects(1).ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible)
Dim hit As Boolean
hit = Not Application.Intersect(r, Target) Is Nothing
If hit Then
Range("A1").Value = "Inside"
Else
Range("A1").Value = "Outside"
End If
Application.EnableEvents = True
End Sub
otherwise for all visible and non-visible cells use
Set r = ListObjects(1).DataBodyRange

Related

Hide all Rows except matching value

I'm working with some data in excel spanning B9:AJ1108 - so multiple rows and columns. I am looking to hide all rows except where the value in column B matches the number in cell C5.
I've tried multiple and can only just about get everything to hide but the unhiding is the issue. I understand how to hide all and how to unhide all. What I need help with is how to hide all and then unhide if something matches the value in C5.
Code so far:
Private Sub CommandButton2_Click()
Worksheets("Employee information").Range("B9:B1108").Rows.Hidden = False
End Sub
Private Sub CommandButton1_Click()
Worksheets("Employee information").Range("B9:B1108").Rows.Hidden = True
'Need to put in the argument to search for C5 value
End Sub
I would also like this to be button controlled but I don't know if that is a case of creating a module or just code within the sheet?
For unhiding the rows you can use "Rows.EntireRow.Hidden = False"
If you want to use a button for the macro to get executed, create a button and excel will ask you which macro you want to get when you click the button.
value= Worksheets("Employee information").cells(5,3).value
That will give you the value of the cell C5, now you need to go through the rows and look for this value.
Hide Rows Not Containing Criteria in Column
Private Sub CommandButton1_Click()
With Worksheets("Employee information")
' Define Criteria (restrict to numbers).
Dim Criteria As Variant
Criteria = .Range("C5").Value
If Not IsNumeric(Criteria) Then
Exit Sub
End If
' Define Criteria Range.
Dim rng As Range
Set rng = .Range("B9:B1108")
End With
' Declare additional variables.
Dim hRng As Range ' Hide Range
Dim cel As Range ' Current Cell (in Source Range)
Dim CurVal As Variant ' Current Value (of Current Cell in Source Range)
' Create a union (Hide Range) of all the cell ranges
' that do not contain Criteria.
For Each cel In rng.Cells
' Evaluate Current Value.
CurVal = cel.Value
If IsNumeric(CurVal) Then
If CurVal = Criteria Then
GoTo NextCell ' Match found: do nothing.
End If
End If
' Match not found: add Current Cell to Hide Range.
If Not hRng Is Nothing Then
Set hRng = Union(hRng, cel)
Else
Set hRng = cel
End If
NextCell:
Next cel
' Hide rows of Hide Range.
If Not hRng Is Nothing Then
hRng.Rows.Hidden = True
End If
End Sub

Need help changing cell values when cell in same row changes

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

Add a Value Automatically to a Cell Based on Another Cell

I want to add a value to a cell based on another with VBA but I'm not sure how. I already searched on internet about it but can't find anything.
I have a table, and on the Column C, if any cell contains the text "MAM" (because it might have MAM-565), then change the value from Cell A to "Wrong", but if it contains "NAC", then change value to "Correct". It should be in the same row as the text found.
Also, I want to add the date automatically to cell E every time Cell in D is filled.
This the code I have already:
Private Sub Worksheet_Change(ByVal Target As Range)
'Add Issue Type'
Dim Code As Range
Set Code = Range("C2:C100000")
For Each Cell In Code
If InStr(1, Cell, "NAC") Then
Range("A2:A10000").Value = "Correct"
ElseIf InStr(1, Cell, "MAM") Then
Range("A2:A10000").Value = "Wrong"
End If
Next
End Sub
This how my table looks like:
Table
Thanks in advance guys :)
To automatically add the datestamp:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng as Range
Set rng = Intersect(Target, Me.Range("D:D"))
If rng Is Nothing Then Exit Sub
On Error GoTo SafeExit
Application.EnableEvents = False
Dim cell as Range
For Each cell in rng
If Not IsEmpty(cell) Then ' don't do anything if cell was cleared
cell.Offset(,1).Value = Date
End If
Next
SafeExit:
Application.EnableEvents = True
End Sub
As far as the Correct/Wrong, this can easily be done with a formula (ISNUMBER(SEARCH(...)). I don't see the need for VBA here.
Even better, create a table using Ctrl+T. Excel will automatically add the formula in column A in new rows.

Override conditional formatting with Worksheet.BeforeDoubleClick event

I am using this rule to format every other row depending on criteria in column B:
=IF(ISEVEN(LEFT($B1, FIND("-", $B1)-1)),MOD(ROW(),2))
I also want to be able to double-click a cell in a particular column to toggle highlighting that row with:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, tb.ListColumns("Domain").DataBodyRange) Is Nothing Then
Cancel = True
Target.Name = "HighlightRow"
With ActiveCell
Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)).Interior.ColorIndex = 36
End With
End If
End Sub
With reference to this answer, how can I override the rule so that the Worksheet.BeforeDoubleClick event takes precedence?
How can I adapt the Worksheet.BeforeDoubleClick event to toggle highlighting?
Before I start...I'm a little confused, is your conditional formatting formula supposed to be
=IF(ISEVEN(LEFT($B1, FIND("-", $B1)-1)),MOD(ROW(),2))
...which only formats Even numbers in column B on every Odd row?
leaving out all Odd numbers and all Even rows?
Anyway, you need to store the extra information of which cells are highlighted somewhere that the conditional formatting can use it.
Easy Way...
The easiest suggestion would be to add a hidden column called Highlight and refer to it in the conditional format.
Or Hard Way...
You could add a conditional format that takes priority and stops the others from being applied. I still used the Named Range idea from the other solution. I could have kept track of the highlighted range using a variable, but I think this works better. I also made it so that you could have multiple colors if you wanted (but I didn't add prioritization).
Enjoy...(I did)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("B:B"), Target) Is Nothing Then
ToggleHighlight Target.EntireRow, Range("A2:H50")
Cancel = True
End If
End Sub
Toggle Highlight
Sub ToggleHighlight(Target As Range, _
Optional TableArea As Range = Cells, _
Optional Name As String = "Yellow", _
Optional ColorIndex As Integer = 19)
Dim Formula As String
Dim HighlightedRows As Range
' Use unique names to allow multiple highlights/colors
' This is the formula we will apply to the highlighted area
Formula = "=OR(TRUE,""Highlight""=""" & Name & """)"
On Error Resume Next
' Check if the target cell that was clicked is within the table area
Set Target = Intersect(Target, TableArea)
If Target is Nothing Then Exit
' Get the current highlighted rows
Set HighlightedRows = ThisWorkbook.Names("HighlightedRows_" & Name).RefersToRange
ThisWorkbook.Names("HighlightedRows_" & Name).Delete
On Error GoTo 0
If HighlightedRows Is Nothing Then
Set HighlightedRows = Target ' We'll apply .EntireRow later
Else
' Remove previous Conditional Formats
Dim Condition As FormatCondition
For Each Condition In HighlightedRows.FormatConditions
With Condition
If .Formula1 = Formula Then .Delete
End With
Next
' Now, toggle the Target range/row
If Intersect(HighlightedRows, Target) Is Nothing Then
' We know that both HighlightedRows and Target are Not Nothing, so
Set HighlightedRows = Union(HighlightedRows, Target.EntireRow)
Else
' We're going to limit the (Big) area to a single column, because it's slow otherwise
Set HighlightedRows = InvertRange(Target.EntireRow, Intersect(HighlightedRows, TableArea.Columns(1)))
End If
End If
' Apply the new Conditional Formatting...
If Not HighlightedRows Is Nothing Then
' HighlightedRows is still set to the EntireRow
Set HighlightedRows = Intersect(HighlightedRows.EntireRow,TableArea)
With HighlightedRows
.Name = "HighlightedRows_" & Name
.FormatConditions.Add Type:=xlExpression, Formula1:=Formula
With .FormatConditions(.FormatConditions.Count)
' Make sure it's first
.SetFirstPriority
' and that no other format is applied
.StopIfTrue = True
.Interior.ColorIndex = ColorIndex
End With
End With
End If
End Sub
Invert Range
Function InvertRange(Target As Excel.Range, Optional LargeArea As Variant) As Excel.Range
' Returns the Inverse or Relative Complement of Target in LargeArea
' InvertRange = LargeArea - Target
Dim BigArea As Excel.Range
Dim Area As Excel.Range
Dim Cell As Excel.Range
If IsMissing(LargeArea) Then
Set BigArea = Target.Parent.UsedRange
Else
Set BigArea = LargeArea
End If
If Target Is Nothing Then
Set InvertRange = BigArea
ElseIf BigArea Is Nothing Then
' nothing to do; will return Nothing
Else
For Each Area In BigArea.Areas
For Each Cell In Area.Cells
If Intersect(Cell, Target) Is Nothing Then
If InvertRange Is Nothing Then
Set InvertRange = Cell
Else
Set InvertRange = Union(InvertRange, Cell)
End If
End If
Next Cell
Next Area
End If
End Function
Edit
I updated it to include TableArea, to limit the Highlights, as well as a Check that the Target and Table Area are on the same sheet and intersect.

Changing the value of a cell when all cells in a range equal the same value

I’m trying to create a macro to change the value of a single cell only when all cells in a range are of a specific value.
I’ve looked around and it seems I can only do this with a worksheet change macro based on a variant.
Based on this, I have put together the following:
Sub Worksheet_Change()
Dim VarItemName As Variant
VarItemName = Range("Other_Checks!G85:G87")
Dim Value As String
Application.EnableEvents = False
If Range("Other_Checks!G85, Other_Checks!G86, Other_Checks!G87").Value = "N/A" Then
Range("Other_Checks!G88").Value = "N/A"
Else
Range("Other_Checks!G88").Value = "Pending"
Application.EnableEvents = True
End If
End Sub
The problem is it only seems to work if the first cell in the range (G85) changes (regardless of the value of the other 2 cells).
What am I doing wrong?
This works for me using the Worksheet_Change event.
You'll need to substitute your range references.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim VarItemName As Range, cl As Range
If Not Intersect(Target, Range("A1:C1")) Is Nothing Then
If Range("A1") = "n/a" And Range("B1") = "n/a" And Range("C1") = "n/a" Then
Range("A2") = "n/a"
Else
Range("A2") = "Pending"
End If
End If
End Sub
By the way, this could easily be done using an IF formula on the spreadsheet. It may be an option to consider?

Resources