View Full Version : Excel VBA Highlighting dates in a range which match a date from an inputbox
bjason
04-02-2018, 05:46 AM
I would like to set up a macro which highlights dates that match the date from an input box. This is the code I have tried so far:
'Highlight Dates Riding the Data Date
Dim answer As Variant
answer = InputBox("What is the data date?", "Help me, help you")
For Each Cel In Range(Cells(2, 5), Cells(r, 5))
If Cel = answer Then Cel.Style = "Bad"
Next
Thanks in advance for any help or advice.
Logit
04-02-2018, 08:47 AM
.
Here is one way :
Option Explicit
Sub FindAll()
'PURPOSE: Find all cells containing a specified values
'SOURCE: www.TheSpreadsheetGuru.com
Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range
Dim TextBox1 As TextBox
'What value do you want to find (must be in string form)?
fnd = Sheets("Sheet1").TextBox1.Value '<--- specify which sheet here
Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
'Test to see if anything was found
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Else
GoTo NothingFound
End If
Set rng = FoundCell
'Loop until cycled through all unique finds
Do Until FoundCell Is Nothing
'Find next cell with fnd value
Set FoundCell = myRange.FindNext(after:=FoundCell)
'Add found cell to rng range variable
Set rng = Union(rng, FoundCell)
'Test to see if cycled through to first found cell
If FoundCell.Address = FirstFound Then Exit Do
Loop
'Select Cells Containing Find Value
rng.Select
Exit Sub
'Error Handler
NothingFound:
MsgBox "No values were found in this worksheet"
End Sub
Sub HighlightFindValues()
'PURPOSE: Highlight all cells containing a specified values
'SOURCE: www.TheSpreadsheetGuru.com
Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range
Dim TextBox1 As TextBox
'What value do you want to find (must be in string form)?
fnd = Sheets("Sheet1").TextBox1.Value
Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
'Test to see if anything was found
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Else
GoTo NothingFound
End If
Set rng = FoundCell
'Loop until cycled through all unique finds
Do Until FoundCell Is Nothing
'Find next cell with fnd value
Set FoundCell = myRange.FindNext(after:=FoundCell)
'Add found cell to rng range variable
Set rng = Union(rng, FoundCell)
'Test to see if cycled through to first found cell
If FoundCell.Address = FirstFound Then Exit Do
Loop
'Highlight Found cells yellow
rng.Interior.Color = RGB(255, 255, 0)
Exit Sub
'Error Handler
NothingFound:
MsgBox "No values were found in this worksheet"
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.