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

Event2020

Board Regular
Joined
Jan 6, 2011
Messages
88
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

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,980
Office Version
  1. 2016
Platform
  1. Windows
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
 

Event2020

Board Regular
Joined
Jan 6, 2011
Messages
88
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
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,980
Office Version
  1. 2016
Platform
  1. Windows
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?
 

Event2020

Board Regular
Joined
Jan 6, 2011
Messages
88

ADVERTISEMENT

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
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,980
Office Version
  1. 2016
Platform
  1. Windows
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).
 

Event2020

Board Regular
Joined
Jan 6, 2011
Messages
88
Hi Rick

Ah I understand and you have my thanks for your suggestion all the same.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,112
Messages
5,640,174
Members
417,130
Latest member
Darion2021

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
Top