select rows that match current active cell vba issue

[PTamiggi]

Ok need some help because the error isn't making sense to me. I have 4 dates in column A with around 12 copies of each(12-Jan-24, 19-Jan-24, 26-Jan-24, 02-Feb-24). I want to select a cell in column A and run a macro that will select all rows that have a match. The code I have is working for the dates 12-Jan-24 and 19-Jan-24, but gives an error (see pic) when running the macro when I have either date 26-Jan-24 and 02-Feb-24 active. I plan to cut and paste selected rows as to another sheet within the workbook, eventually after figuring out this issue. Any help would be appreciated.

Option Explicit

Sub Date_Match_Rows_Select()
Dim tableR As Range, cell As Range, d As Range
Dim s As String
Set tableR = Range("A:A")
Set d = Selection
For Each cell In tableR
  If cell = d Then
  s = s & cell.Row & ":" & cell.Row & ", "
  End If
Next cell
s = Left(s, Len(s) - 2)
Range(s).Select
End Sub

 

[Legacy 143009]

Strange.. Here, find a safer version of your code. Maybe it helps:

Option Explicit
Sub Date_Match_Rows_Select()
  Dim tableR As Range, cell As Range, d As Range
  Dim s As Range, lRow As Long
 
  lRow = Cells(Rows.Count, "A").End(xlUp).Row
  Set tableR = Range("A1:A" & lRow)
  Set d = Selection
  Set s = d
  For Each cell In tableR
    If cell.Value2 = d.Value2 Then
      Set s = Union(s, cell)
    End If
  Next cell
  s.EntireRow.Select
End Sub

 

[Peter_SSs]

I am not getting an error with data as you described.
However, I am wondering why you have the code check 1,048,576 cells when you only have about 50 cells with data?

Just wondering if you get different result if you make this change in the code

Set tableR = Range("A:A")
Set tableR = Range("A1:A100")

 

[PTamiggi]

Strange.. Here, find a safer version of your code. Maybe it helps:

Option Explicit
Sub Date_Match_Rows_Select()
  Dim tableR As Range, cell As Range, d As Range
  Dim s As Range, lRow As Long
 
  lRow = Cells(Rows.Count, "A").End(xlUp).Row
  Set tableR = Range("A1:A" & lRow)
  Set d = Selection
  Set s = d
  For Each cell In tableR
    If cell.Value2 = d.Value2 Then
      Set s = Union(s, cell)
    End If
  Next cell
  s.EntireRow.Select
End Sub

This is working perfectly. Thank you.

 

[PTamiggi]

I am not getting an error with data as you described.
However, I am wondering why you have the code check 1,048,576 cells when you only have about 50 cells with data?

Just wondering if you get different result if you make this change in the code

Set tableR = Range("A:A")
Set tableR = Range("A1:A100")

I have tried that, and it didn't make a difference. Thank you for the idea though.

 

[Legacy 143009]

Glad that we could help Thanks for the feedback