Home > OS >  I need this specific command to work on every table on my sheet
I need this specific command to work on every table on my sheet

Time:09-09

So i had this code

Dim cell As Range
Dim rng As Range
Dim FoundRange As Range
Set rng = Range("L54:L4000")
  For Each cell In rng.Cells
  If cell.DisplayFormat.Interior.ColorIndex = 19 Then
  If FoundRange Is Nothing Then
  Set FoundRange = cell
  Else
  Set FoundRange = Union(FoundRange, cell)
   End If
  End If
  Next cell
  If Not FoundRange Is Nothing Then FoundRange.Select
End sub

It selects all cells with a specific color. It works fine on simple sheets, but I have a sheet full of tables I need it to work on as well. At the moment it only selects the cells on the first sheet. My solution was to try and apply it to each table, so i tried this:

Sub Validation()
Dim co As ListObject
Dim cell As Range
Dim rng As Range
Dim FoundRange As Range
Set rng = Range("L54:L4000")
 For Each co In ActiveSheet.ListObjects
  For Each cell In rng.Cells
  If cell.DisplayFormat.Interior.ColorIndex = 19 Then
  If FoundRange Is Nothing Then
  Set FoundRange = cell
  Else
  Set FoundRange = Union(FoundRange, cell)
   End If
  End If
  Next cell
  If Not FoundRange Is Nothing Then FoundRange.Select
 Next co
End sub

The first code applied for each cell and I wanted to treat it as an "integer" and apply it for each table, but I'm bad at coding and it obviously didn't work. Can anyone help please?

CodePudding user response:

You declared a range, rng which has nothing to to with the iterated listObjects...

Please, try the next way:

Sub Validation()
 Dim co As ListObject, cell As Range
 Dim rng As Range, FoundRange As Range

 For Each co In ActiveSheet.ListObjects
    Set rng = co.DataBodyRange 'supposing that you want searching in the table dataBodyRange. 
                               'if you need to do it in the whole table (headers included), you should use co.Range
    For Each cell In rng.cells
        If cell.DisplayFormat.Interior.ColorIndex = 19 Then
            If FoundRange Is Nothing Then
                Set FoundRange = cell
            Else
                Set FoundRange = Union(FoundRange, cell)
             End If
        End If
    Next cell
  Next co
  If Not FoundRange Is Nothing Then FoundRange.Select
End Sub

CodePudding user response:

If you mean tables on different sheets then this code would work.
If it's actual tables you're searching change the rng to look at each ListObject in wrkSht.ListObjects as shown in the answer given by @FaneDuru.

Sub Test()

    Dim wrkSht As Worksheet
    Dim rng As Range
    Dim Cell As Range
    Dim FoundRange As Range
    
    For Each wrkSht In ThisWorkbook.Worksheets
    
        wrkSht.Select 'First time I've used Select in about 10 years.
    
        Set FoundRange = Nothing
        Set rng = wrkSht.Range("L54:L4000")
        
        For Each Cell In rng.Cells
            If Cell.Interior.ColorIndex = 19 Then
                If FoundRange Is Nothing Then
                    Set FoundRange = Cell
                Else
                    Set FoundRange = Union(FoundRange, Cell)
                End If
            End If
        Next Cell
        
        If Not FoundRange Is Nothing Then
            FoundRange.Select 'Second time.....
        End If
        
    Next wrkSht
    
End Sub
  • Related