find in column distinguishing between empty and blank cells - excel

Question

I need to find the first cell in a column that's either empty or contains only blanks. I came up with the following..
Dim FindString As String
Dim Rng As Range
Dim Done As Boolean
FindString = ""
With Sheets("Yahoo").Range("A:A")
Set Rng = .Find(What:=FindString, _
After:=.Cells([Stock_Start_Row], 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
j = Rng.Row
Done = False
Do Until Done
FindString = .Cells(j, 1)
FindString = Replace(FindString, " ", "")
If FindString = "" Then
j = j - 1
Else
Done = True
End If
Loop
MsgBox "Found" & " " & Rng.Row & " " & j
Else
MsgBox "Nothing found"
End If
End With
This will discover and clear any blank cells immediately before the first empty cell but will not discover blank cells among the preceding cells.
Is there any way to search for cells containing one or more blanks?
If so I could add a second search.

Answer 1

I need to find the first cell in a column that's either empty or
contains only blanks.
This will go through column A on sheet("Yahoo"). It should work for you:
Sub FindBlankOrEmptyCells()
Dim wbk As Workbook
Set wbk = ThisWorkbook
Dim ws As Worksheet
Set ws = wbk.Sheets(1)
Dim cell As Range
Dim BlankCounter As Integer
Dim i As Integer
Dim OldCellValue As Variant ' just for the heck of it
For Each cell In Sheets("Yahoo").Range("A:A")
OldCellValue = cell.Value
cell.NumberFormat = "#"
cell.Value = "'" & cell.Value
BlankCounter = 0
If cell.Value = "" Then
MsgBox "Found an empty cell in Column A, Row: " & " " & cell.Row
Exit Sub
End If
For i = 1 To Len(cell)
If cell.Characters(i, 1).Text = " " Then
BlankCounter = BlankCounter + 1
End If
If BlankCounter = Len(cell) Then
MsgBox "Found a cell full of blanks in Column A, Row: " & " " & cell.Row
cell.Clear
cell.Value = OldCellValue
cell.Value = cell.Value
Exit Sub
' If you want to delete the contents of the cell or continue looping you can delete this Exit Sub and put in:
' cell.ClearContents
' then it will loop through all the cells and delete blanks and message you each time
End If
Next i
cell.Clear
cell.Value = OldCellValue
cell.Value = cell.Value
Next cell
End Sub
This will find the first cell that is either empty or contains only blanks(spaces). It will stop once it finds a cell that meets that criteria. If you want to continue looping you can enable the code I commented out. Let me know how it works.
EDIT:
If you want to use the .find function to gain some efficiency that is possible - but eventually you are going to need to loop through all the characters in a cell and determine if it contains all spaces. Try this one out(I stopped it at row 30 so it doesn't keep popping up messages for blanks - but you could remove the messages and extend to Loop Until to row 999999):
Sub FindBlankOrEmptyCellsWithFindFunction()
Dim FindString As String
Dim Rng As Range
Set Rng = Sheets("Yahoo").Range("A1")
Dim Done As Boolean
Dim wbk As Workbook
Set wbk = ThisWorkbook
Dim ws As Worksheet
Set ws = wbk.Sheets(1)
Dim cell As Range
Dim BlankCounter As Integer
Dim i As Integer
Dim ii As Integer
Dim LoopStopperRange As Range
Dim OldCellValue As Variant
ii = 0
Do
ii = ii + 1
FindString = " "
With Sheets("Yahoo").Range("A:A")
Set Rng = .Find(What:=FindString, _
After:=.Cells(Rng.Row, 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then ' If Rng Is Something Then
If ii = 1 Then
Set LoopStopperRange = Rng
End If
If LoopStopperRange = Rng And ii > 1 Then
Exit Do
End If
For Each cell In Rng
OldCellValue = cell.Value
cell.NumberFormat = "#"
cell.Value = "'" & cell.Value
BlankCounter = 0
If cell.Value = "" Then
MsgBox "Found an empty cell in Column A, Row: " & " " & cell.Row
'Exit Sub
End If
For i = 1 To Len(cell)
If cell.Characters(i, 1).Text = " " Then
BlankCounter = BlankCounter + 1
End If
If BlankCounter = Len(cell) Then
MsgBox "Found a cell full of blanks in Column A, Row: " & " " & cell.Row
cell.Clear
cell.Value = OldCellValue
cell.Value = cell.Value
'Exit Sub
' If you want to delete the contents of the cell or continue looping you can delete this Exit Sub and put in:
' cell.ClearContents
' then it will loop through all the cells and delete blanks
End If
Next i
cell.Clear
cell.Value = OldCellValue
cell.Value = cell.Value
Next cell
Else
End If
End With
Loop Until Rng Is Nothing
Set Rng = Sheets("Yahoo").Range("A1")
Do
ii = ii + 1
FindString = ""
With Sheets("Yahoo").Range("A:A")
Set Rng = .Find(What:=FindString, _
After:=.Cells(Rng.Row, 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then ' If Rng Is Something Then
For Each cell In Rng
OldCellValue = cell.Value
cell.NumberFormat = "#"
cell.Value = "'" & cell.Value
BlankCounter = 0
If cell.Value = "" Then
MsgBox "This loop will go until Row 30 so you don't have to pause/break out. Found an empty cell in Column A, Row: " & " " & cell.Row
'Exit Sub
End If
Next cell
Else
End If
End With
Loop Until Rng.Row = 30
'Loop Until Rng.Row = 99999
End Sub
Good Luck.