Trying to create a TextByColor function

[hCizzle]

Hello,

I'm trying to create a function called TextByColor using VBA. The purpose of this function is to read through one of my sheets called "JOB CODES" and the return all the cells with a white or yellow cell background to a sheet called "TV". The function should read through all of "JOB CODES", find all the rows with a white or yellow cell backround, and return all of those to the "TV" sheet. Also auto-updating in real time as "JOB CODES" is updated multiple times a day.

I've been trying to get this working all morning but don't have a lot of experience in VBA. I will attach a couple of screenshots of what my sheet looks like, and an example of what "TV" should look like once the function has been run.

My plan is to then use a separate system and PowerQuery to read the data from this file and display it on a TV in a separate room.

Thank you!!

 

[Micron]

You should post the code you tried? Probably much easier to correct/adapt rather than start from scratch. If you post code, please do so within code tags (vba button on posting toolbar) to maintain indentation and readability.

 

[hCizzle]

You should post the code you tried? Probably much easier to correct/adapt rather than start from scratch. If you post code, please do so within code tags (vba button on posting toolbar) to maintain indentation and readability.

Apologies! It's my first time posting here.

The VBA code I've been trying is below:

Function TextByColor(rRange As Range, cellColor As Long) As Variant
    Dim result() As Variant
    Dim rowCount As Long
    Dim colCount As Long
    Dim i As Long
    Dim j As Long
    Dim k As Long
    
    rowCount = rRange.Rows.Count
    colCount = rRange.Columns.Count
    k = 0
    
    ReDim result(1 To rowCount, 1 To colCount)
    
    For i = 1 To rowCount
        If rRange.Cells(i, 1).Interior.color = cellColor Then
            k = k + 1
            For j = 1 To colCount
                result(k, j) = rRange.Cells(i, j).Value
            Next j
        End If
    Next i
    
    ReDim Preserve result(1 To k, 1 To colCount)
    
    TextByColor = result
End Function

 

[hCizzle]

You should post the code you tried? Probably much easier to correct/adapt rather than start from scratch. If you post code, please do so within code tags (vba button on posting toolbar) to maintain indentation and readability.

Ignore my follow up message! I've got some VBA code that is working a lot closer to what I'm after. The problem that I'm having with this code is that it seems to work with yellow (255,255,0) but doesn't go all the way down my JOB CODES sheet. It only takes the first 90 yellow rows, and then stops.

And the code doesn't work at all when I input white as the interior color (255,255,255).


VBA CODE:

Sub CopyHighlightedCodes()

    Dim TransIDField As Range
    Dim TransIDCell As Range
    Dim ATransWS As Worksheet
    Dim HTransWS As Worksheet
    
    Set ATransWS = Worksheets("JOB CODES")
    Set TransIDField = ATransWS.Range("A4", ATransWS.Range("A4").End(xlDown))
    Set HTransWS = Worksheets("TV")
    
    For Each TransIDCell In TransIDField
    
        If TransIDCell.Interior.color = RGB(255, 255, 0) Then
        
            TransIDCell.Resize(1, 11).Copy Destination:= _
                HTransWS.Range("A1").Offset(HTransWS.Rows.Count - 1, 0).End(xlUp).Offset(1, 0)
                
        End If
        
    Next TransIDCell
    
    HTransWS.Columns.AutoFit
    
End Sub

 

[Micron]

Where are you getting these codes from?
If you're not getting all the rows there must be an issue with how you determine the last row. Suggest you use something along the lines of

     Lrow = Cells.Find(what:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, _
               searchorder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row

Pretty sure the default cell colour is not white. If you used dark mode, they would not be white unless you had already formatted as white from format dialog.
Research on how to step through your code and use immediate window for testing; e.g. if you were stepping through the code and you were on a row that was white and typed in the immediate window
?TransIDCell.Interior.Color
and hit return, you'd get a value you could use without using rgb values. Or use Debug.Print statements (that you remove or disable when done with them) to see what the output(s) to your tests are:
Debug.Print TransIDCell.Interior.Color
The latter would be more useful in this case if looping and you had several colours you needed values for.

 

[Micron]

I should have tested some things first. I see that 'dark mode' setting leaves the cells as appearing white, which I find weird and unattractive. Presently curious enough to see if it's also possible to get rgb values into immediate window, but not hopeful. In the meantime, I note that while white and default produce the same system colour number, that number has worked for me before when trying to reset cells back to "white". It is 16777215 by the way, but it appears to be a string because I get leading/trailing spaces yet it proves to be a Double.

EDIT -OK it seems I need to post a correction. This returns true regardless of whether the cell is "no color" or is actually white
?sheets("1").range("D1").interior.color=rgb(255,255,255)
True
So I don't know why but I've always had success using 16777215