Yes I tried it, but the number 1 did not show up inside the blue cells.
Here's the code:
'This routine will find the blank cells in a worksheet and
'highlight them blue in a new worksheet. The new worksheet
'is hardcoded with the unique ID from column "A" and has the
'field headers. The user is propted for several inputs.
'Chris Version
Public Sub BlankChecker()
'Declare all your variables
Dim oOrgRng, oRng As Range 'range properties
Dim oColRng, oNewColRng As Range
Dim oHdRow, oNewHdRow As Range
Dim oRngEnd As String 'will be input by user
Dim oSheetName As String 'will be input by user
Dim oNewRange, oNewBlankRange As Range 'new range properties
Dim oSht As Worksheet 'new worksheet with blanks
'Prompt user for Sheet Name
oSheetName = InputBox("Enter Name of Worksheet to inspect.")
'Prompt user for Last Cell
oRngEnd = InputBox("Enter the range of Worksheet to inspect.")
'Construct the area to be checked
Set oOrgRng = Sheets(oSheetName).Range(oRngEnd)
'Now select it
oOrgRng.Select
'Make sure you get the blank cells
Set oRng = oOrgRng.SpecialCells(xlCellTypeBlanks)
'if there are no blank cells found, exit this sub directly
'If there are blank cells, here's the branching logic
If oRng.Count > 0 Then
'Create one new sheet
Set oSht = Sheets.Add
'Name new sheet Blanks;
oSht.Name = "Located Blanks"
'Select the Unique ID field to paste
Set oColRng = Sheets(oSheetName).Range("A1:A65000")
Sheets(oSheetName).Select
oColRng.Select
'Perform the row Copy
Application.CutCopyMode = False
Selection.Copy
'Activate the new sheet
Sheets("Located Blanks").Select
'Select the cell origin for the paste
Call Range("A1:A65000").PasteSpecial(xlPasteAll)
Set oNewColRng = Selection
'Select the Header row fields to paste
Set oHdRow = Sheets(oSheetName).Range("B1:IV1")
Sheets(oSheetName).Select
oHdRow.Select
'Perform the row Copy
Application.CutCopyMode = False
Selection.Copy
'Activate the new sheet
Sheets("Located Blanks").Select
'Select the cell origin for the paste
Call Range("B1:IV1").PasteSpecial(xlPasteAll)
Set oNewHdRow = Selection
'select the Blank Cell source range
Sheets(oSheetName).Select
oOrgRng.Select
'Perform the copy
Application.CutCopyMode = False
Selection.Copy
'Select the newly created blanks sheet
Sheets("Located Blanks").Select
'Select the cell origin for paste
Call Range("B2").PasteSpecial(xlPasteAll)
Set oNewRange = Selection
Set oNewBlankRange = oNewRange.SpecialCells(xlCellTypeBlanks)
' I set the interior color of these blankcells to blue
oNewBlankRange.Interior.Color = RGB(0, 0, 255)
oNewBlankRange.Value = 1
'Let the user know the procedure was successful
MsgBox "Your blank cells were found and are ready for viewing."
'The contents from the source range werew copied to the
'new sheet. Now do some housecleaning and clear up your mess
oNewRange.ClearContents
End If
End Su
