Fill background colour of only cells which contain data using VBA?

E

Event2020

Board Regular
Joined
Jan 6, 2011
Messages
107
Office Version
  1. 2019
Platform
  1. Windows
Hi all

I have a worksheet that I use VBA to fill with data by opening a delimited txt file and importing the data while
applying various formulas.

The columns that contain data always remain static: Columns A:H

This works perfectly.

However, I have been struggling to workout a way of applying a specific background colour to only cells that contain data.

The number of cells that can have data changes with each txt file import so I need VBA to check each cell for data and
than only apply the background colour to those cells.

I know how to apply a background to a specific range and how to use conditional formatting but its writing the VBA code and
taking account of the "ever changing" dynamic part I am unable to work out.

Any help would be gratefully accepted.
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Sort by date Sort by votes
Assuming the cells without data are really blank and do not come in with a value of "", then this single line of code should work...
VBA Code: 
Sub ColorCellsWithValues()
  Columns("A:H").SpecialCells(xlConstants).Interior.Color = vbYellow
End Sub
 
Upvote 0
Hi Rick

Thank you for your very kind reply which I have tried and it produces a error:
Run-time error '1004'
Unable to get the SpecialCells property of the Range class.

Here is what I have tried.

At the end of my existing VBA (that imports the data and processes it with formulas) but before the End Sub
I inserted your code as you wrote it
VBA Code: 
Columns("A:H").SpecialCells(xlConstants).Interior.Color = vbYellow

and then

VBA Code: 
.Columns("A:H").SpecialCells(xlConstants).Interior.Color = vbYellow
which produced the error

then as my worksheet is already defined as
VBA Code: 
Dim TWs as Worksheet
Dim Lr As Long
Dim Answer
Set TWs = Worksheets("Pack")

I tried
VBA Code: 
TWs.Columns("A:H").SpecialCells(xlConstants).Interior.Color = vbYellow
and
VBA Code: 
Worksheets("Pack").Columns("A:H").SpecialCells(xlConstants).Interior.Color = vbYellow
 
Upvote 0
I tested the code before I posted it and it worked fine for me. Your cells contain constants (not formulas), correct? If so, are you by any chance using a Mac computer?
 
Upvote 0
Hi Rick

I am on Windows 10
Excel 2019

I didnt post my whole sub as its quite big but perhaps it may help in this case.

As this is a work in progress, the parts that are commented out with a ' are variations or previously used bits of code that
I keep in case I need to refer back to them. When the workbook is finished a clean version will be saved with all the unused
code removed.

VBA Code: 
Sub InsertFormulasPack()
    Dim SWs As Worksheet, TWs As Worksheet
    Dim Lr As Long
    Dim Answer
    Set SWs = Worksheets("FolderDataImport")
    Set TWs = Worksheets("Pack")
    Lr = SWs.Range("A" & SWs.Rows.Count).End(xlUp).Row
        Answer = MsgBox("Would You Like To Insert Pack Formulas?", vbYesNo, "Insert Pack Formulas")
            If Answer <> vbYes Then Exit Sub
        Application.ScreenUpdating = False
        Sheets("Pack").Select
            With ActiveWindow
                .SplitColumn = 0
                .SplitRow = 1
            End With
        ActiveWindow.FreezePanes = True
        ActiveSheet.Columns.ColumnWidth = 1
        Cells.EntireColumn.AutoFit
    For I = 1 To ActiveSheet.UsedRange.Columns.Count
        Columns(I).ColumnWidth = Columns(I).ColumnWidth + 6
        Columns(I).Rows.RowHeight = 18
                Columns("A:A").Select
                Selection.ColumnWidth = 8
                Columns("B:B").Select
                Selection.ColumnWidth = 38
                Columns("C:C").Select
                Selection.ColumnWidth = 45
                Columns("D:D").Select
                Selection.ColumnWidth = 22
                Columns("E:E").Select
                Selection.ColumnWidth = 16
                Columns("F:F").Select
                Selection.ColumnWidth = 16
                Columns("G:G").Select
                Selection.ColumnWidth = 16
                Columns("H:H").Select
                Selection.ColumnWidth = 16
    Next I
        Range("A:H").CurrentRegion.ClearContents
        Range("A1:H1").Borders(xlEdgeBottom).LineStyle = xlContinuous
        Range("A1:H1").Borders(xlEdgeBottom).Weight = xlMedium
        Range("A1").EntireRow.Font.Bold = True
        Range("A1").EntireRow.VerticalAlignment = xlCenter
            [A1].Value = "LOOKUP"
            [B1].Value = "ARTIST"
            [C1].Value = "SONG TITLE"
            [D1].Value = "PACK TYPE"
            [E1].Value = "TRACK COUNT"
            [F1].Value = "SAMPLE RATE"
            [G1].Value = "BIT RATE"
            [H1].Value = "FILE TYPE"
        
'       Column A Formula
        TWs.Range("A2:A" & Lr + 1).Formula = "=IF(FolderDataImport!A1="""","""",TEXT(ROW(FolderDataImport!A1),""000""))"
'       TWs.Range("A2:A" & Lr + 1).Formula = "=IF(FolderDataImport!A1>"""",TEXT(ROW(FolderDataImport!A1),""000""),"""")"

'       Column B Formula
        TWs.Range("B2:B" & Lr + 1).Formula = "=IF(FolderDataImport!A1="""","""",SUBSTITUTE(LEFT(FolderDataImport!A1,FIND(""_-_"",FolderDataImport!A1)-1),""_"","" ""))"
'       TWs.Range("B2:B" & Lr + 1).Formula = "=IF(FolderDataImport!A1>"""",SUBSTITUTE(LEFT(FolderDataImport!A1,FIND(""_-_"",FolderDataImport!A1)-1),""_"","" ""))"
    
'       Column C Formula
        TWs.Range("C2:C" & Lr + 1).Formula = "=IF(FolderDataImport!A1="""","""",SUBSTITUTE(MID(LEFT(FolderDataImport!A1,FIND(""["",FolderDataImport!A1)-2),FIND(""_-_"",FolderDataImport!A1)+3,LEN(FolderDataImport!A1)),""_"","" ""))"
'       TWs.Range("C2:C" & Lr + 1).Formula = "=IF(FolderDataImport!A1>"""",SUBSTITUTE(MID(LEFT(FolderDataImport!A1,FIND(""["",FolderDataImport!A1)-2),FIND(""_-_"",FolderDataImport!A1)+3,LEN(FolderDataImport!A1)),""_"","" ""))"
    
'       Column D Formula
        TWs.Range("D2:D" & Lr + 1).Formula = "=IF(FolderDataImport!A1="""","""",SUBSTITUTE(MID(LEFT(FolderDataImport!A1,FIND(""]"",FolderDataImport!A1)-1),FIND(""["",FolderDataImport!A1)+1,LEN(FolderDataImport!A1)),""_"","" ""))"
'       TWs.Range("D2:D" & Lr + 1).Formula = "=IF(FolderDataImport!A1>"""",SUBSTITUTE(MID(LEFT(FolderDataImport!A1,FIND(""]"",FolderDataImport!A1)-1),FIND(""["",FolderDataImport!A1)+1,LEN(FolderDataImport!A1)),""_"","" ""))"
    
'       Column E Formula
        TWs.Range("E2:E" & Lr + 1).Formula = "=IF(FolderDataImport!A1="""","""",LOOKUP(9^9,0+RIGHT(LEFT(FolderDataImport!A1,FIND(""_Tracks"",FolderDataImport!A1)-1),ROW($1:$99)))&"" Tracks"")"
'       TWs.Range("E2:E" & Lr + 1).Formula = "=IF(FolderDataImport!A1>"""",SUBSTITUTE(IFERROR(MID(LEFT(FolderDataImport!A1,FIND("")"",FolderDataImport!A1,FIND(""]"",FolderDataImport!A1))-1),FIND(""("",FolderDataImport!A1,FIND(""]"",FolderDataImport!A1))+1,99),""""),""_"","" ""),"""")"
    
'       Column F Formula
        TWs.Range("F2:F" & Lr + 1).Formula = "=IF(FolderDataImport!A1="""","""",LOOKUP(9^9,0+RIGHT(LEFT(FolderDataImport!A1,FIND(""_kHz"",FolderDataImport!A1)-1),ROW($1:$99)))&"" kHz"")"
'       TWs.Range("F2:F" & Lr + 1).Formula = "=IF(FolderDataImport!A1="""","""",SUBSTITUTE(MID(LEFT(FolderDataImport!A1,FIND("")"",FolderDataImport!A1,FIND(""]"",FolderDataImport!A1))-1),FIND(""("",FolderDataImport!A1,FIND(""]"",FolderDataImport!A1))+1,99),""_"","" ""))"
'       TWs.Range("F2:F" & Lr + 1).Formula = "=IF(FolderDataImport!A1>"""",LOOKUP(9^9,0+RIGHT(LEFT(FolderDataImport!A1,FIND(""_kHz"",FolderDataImport!A1)-1),ROW($1:$99)))&"" kHz"","""")"
    
'       Column G Formula
        TWs.Range("G2:G" & Lr + 1).Formula = "=IF(FolderDataImport!A1="""","""",SUBSTITUTE(" & _
        "IF(ISNUMBER(SEARCH(""_wav"",FolderDataImport!A1)),MID(FolderDataImport!A1,SEARCH(""kHz"",FolderDataImport!A1)+4,SEARCH(""_Wav"",FolderDataImport!A1)-SEARCH(""kHz"",FolderDataImport!A1)-4)," & _
        "IF(ISNUMBER(SEARCH(""flac"",FolderDataImport!A1)),MID(FolderDataImport!A1,SEARCH(""kHz"",FolderDataImport!A1)+4,SEARCH(""flac"",FolderDataImport!A1)-SEARCH(""kHz"",FolderDataImport!A1)-5)," & _
        "IF(ISNUMBER(SEARCH(""macOS"",FolderDataImport!A1)),MID(FolderDataImport!A1,SEARCH(""kHz"",FolderDataImport!A1)+4,SEARCH(""macOS"",FolderDataImport!A1)-SEARCH(""kHz"",FolderDataImport!A1)-5)," & _
        "IF(ISNUMBER(SEARCH(""Aif"",FolderDataImport!A1)),MID(FolderDataImport!A1,SEARCH(""kHz"",FolderDataImport!A1)+4,SEARCH(""Aif"",FolderDataImport!A1)-SEARCH(""kHz"",FolderDataImport!A1)-5)," & _
        "IF(ISNUMBER(SEARCH(""Mp3"",FolderDataImport!A1)),MID(FolderDataImport!A1,SEARCH(""Kbps"",FolderDataImport!A1)-4,SEARCH(""Mp3"",FolderDataImport!A1)-SEARCH(""mp3"",FolderDataImport!A1)+9)," & _
        "IF(ISNUMBER(SEARCH(""Mogg"",FolderDataImport!A1)),MID(FolderDataImport!A1,SEARCH(""kHz"",FolderDataImport!A1)+4,SEARCH(""Mogg"",FolderDataImport!A1)-SEARCH(""kHz"",FolderDataImport!A1)-5),"""")))))),""_"","" ""))"
'       TWs.Range("G2:G" & Lr + 1).Formula = "=IF(FolderDataImport!A1="""","""",SUBSTITUTE(IF(ISNUMBER(SEARCH(""wav"",FolderDataImport!A1)),MID(FolderDataImport!A1,SEARCH(""kHz"",FolderDataImport!A1)+4,SEARCH(""Wav"",FolderDataImport!A1)-SEARCH(""kHz"",FolderDataImport!A1)-5),IF(ISNUMBER(SEARCH(""flac"",FolderDataImport!A1)),MID(FolderDataImport!A1,SEARCH(""kHz"",FolderDataImport!A1)+4,SEARCH(""flac"",FolderDataImport!A1)-SEARCH(""kHz"",FolderDataImport!A1)-5),IF(ISNUMBER(SEARCH(""mp3"",FolderDataImport!A1)),MID(FolderDataImport!A1,SEARCH(""kbps"",FolderDataImport!A1)+5,SEARCH(""mp3"",FolderDataImport!A1)-SEARCH(""mp3"",FolderDataImport!A1)+7)&"" (""&MID(FolderDataImport!A1,SEARCH(""kHz"",FolderDataImport!A1)+4,SEARCH(""mp3"",FolderDataImport!A1)-SEARCH(""kHz"",FolderDataImport!A1)-12)&"")"",IF(ISNUMBER(SEARCH(""mogg"",FolderDataImport!A1)),MID(FolderDataImport!A1,SEARCH(""kHz"",FolderDataImport!A1)+4,SEARCH(""mogg"",FolderDataImport!A1)-SEARCH(""kHz"",FolderDataImport!A1)-5),"""")))),""_"","" ""))"
'       TWs.Range("G2:G" & Lr + 1).Formula = "=IF(FolderDataImport!A1>"""",SUBSTITUTE(IF(ISNUMBER(SEARCH(""wav"",FolderDataImport!A1)),MID(FolderDataImport!A1,SEARCH(""kHz"",FolderDataImport!A1)+4,SEARCH(""Wav"",FolderDataImport!A1)-SEARCH(""kHz"",FolderDataImport!A1)-5),IF(ISNUMBER(SEARCH(""flac"",FolderDataImport!A1)),MID(FolderDataImport!A1,SEARCH(""kHz"",FolderDataImport!A1)+4,SEARCH(""flac"",FolderDataImport!A1)-SEARCH(""kHz"",FolderDataImport!A1)-5),IF(ISNUMBER(SEARCH(""mp3"",FolderDataImport!A1)),MID(FolderDataImport!A1,SEARCH(""kbps"",FolderDataImport!A1)+5,SEARCH(""mp3"",FolderDataImport!A1)-SEARCH(""mp3"",FolderDataImport!A1)+7)&""   (""&MID(FolderDataImport!A1,SEARCH(""kHz"",FolderDataImport!A1)+4,SEARCH(""mp3"",FolderDataImport!A1)-SEARCH(""kHz"",FolderDataImport!A1)-12)&"")"",IF(ISNUMBER(SEARCH(""mogg"",FolderDataImport!A1)),MID(FolderDataImport!A1,SEARCH(""kHz"",FolderDataImport!A1)+4,SEARCH(""mogg"",FolderDataImport!A1)-SEARCH(""kHz"",FolderDataImport!A1)-5),"""")))),""_"","" ""),"""")"
    
'       Column H Formula
        TWs.Range("H2:H" & Lr + 1).Formula = "=IF(FolderDataImport!A1="""","""", IF(ISNUMBER(SEARCH(""wav"",FolderDataImport!A1)),""Wav"", IF(ISNUMBER(SEARCH(""flac"",FolderDataImport!A1)),""Flac"", IF(ISNUMBER(SEARCH(""macOS"",FolderDataImport!A1)),""macOS"", IF(ISNUMBER(SEARCH(""aif"",FolderDataImport!A1)),""Aif"", IF(ISNUMBER(SEARCH(""mp3"",FolderDataImport!A1)),""MP3"", IF(ISNUMBER(SEARCH(""mogg"",FolderDataImport!A1)),""Mogg"",""no"")))))))"
'       TWs.Range("H2:H" & Lr + 1).Formula = "=IF(FolderDataImport!A1>"""",IF(ISNUMBER(SEARCH(""wav"",FolderDataImport!A1)),""Wav"", IF(ISNUMBER(SEARCH(""flac"",FolderDataImport!A1)),""Flac"",IF(ISNUMBER(SEARCH(""mp3"",FolderDataImport!A1)),""MP3"", IF(ISNUMBER(SEARCH(""mogg"",FolderDataImport!A1)),""Mogg"",""no"")))),"""")"
        
        Worksheets("Pack").Columns("A:H").SpecialCells(xlconstrants).Interior.Color = vbYellow
        
        ActiveSheet.Range(ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1), ActiveSheet.Cells(Rows.Count, 1)).EntireRow.RowHeight = 10
        Application.ScreenUpdating = True
End Sub
 
Upvote 0
You are filling Columns A:H with formulas... my suggested code only works with constants (when I hear the words "data" and "importing the data", I think of constants, not formulas).
 
Upvote 0
Hi Rick

Ah I understand and you have my thanks for your suggestion all the same.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
VBA To Filter Conditionally Formatted coloured cells in multiple columns
Replies
1
Views
126
bobsan42
bobsan42
P
  • Question
Applying conditional formatting to merged cells
Replies
1
Views
263
Joe4
Joe4
A
  • Question
VBA to change cell colour based on content
Replies
3
Views
151
Snakehips
Snakehips
J
  • Solved
Using active cell to set text and fill colour of other cells in a multiple selection
2
Replies
10
Views
536
jmason
J
S
  • Solved
Filling cells partially (based on percentage) and any colour of my choice
Replies
7
Views
445
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,641
Messages
6,120,685
Members
448,977
Latest member
dbonilla0331

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top