I've made a For Each loop that'll keep data depending upon some criteria's, but I do not know how to format it so if a cell in column A contain exactly 8 numeric digits, then it'll keep the row.
Example:
Cell A289 Contains: 04245468 ← Keep this row
Cell A978 Contains: 04513 ← Delete this row
So far I have the following by using the left function within my code:
Sub CleanUpSheet1()
Dim RowA As Range
'hides any popups
Application.DisplayAlerts = False
'Deletes all blanks up to row 15,0000
Range("a2:A15000").Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For Each RowA In Range("A2:A" & ActiveSheet.UsedRange.Rows.Count)
If Left(RowA.Value, 5) <> "issue" And Right(RowA.Value, 4) <> "-000" And RowA.Value <> 0 Then
RowA.EntireRow.Delete
End If
Next
're-enables popups
Application.DisplayAlerts = True
End Sub
If it's just a matter of numbers you can transform the cell value into a string (RowA.Text or maybe Cstr(RowA.Value) and then test on the lenght :
if len(cstr(RowA.Value)) = 8 ???
(or len(RowA.Text))
Tell me if I havn't understood your question.
Had to reformat this a lot.
Sub CleanUpSelect1()
Dim RowA As Range
Dim cRng As Range
Dim iCounter As Long
Set RowA = Sheet1.Range("A2:A" & Sheets("Sheet1").UsedRange.Rows.Count)
iCounter = 1
Do
Set cRng = RowA(iCounter, 1) 'Loop rows
If CStr(cRng.Value2) = vbNullString Then
cRng.EntireRow.Delete
Else
If Not KeepRow(cRng.Value2) Then
cRng.EntireRow.Delete 'Delete row
Else
iCounter = iCounter + 1 'Advance
End If
End If
Loop While iCounter <= RowA.Rows.Count 'Stop after loop all rows
End Sub
Private Function KeepRow(RowValue As String) As Boolean
KeepRow = (RowValue Like "########" Or RowValue Like "issue#" Or RowValue Like "######-###")
End Function
But it works.
Related
I have a financial data with serial numbers linked to asset. The serial numbers are listed in cell through line breaks, i.e. there could 3,4,5 etc. serial no in a cell. So, the idea is copy and insert rows based on how many serial numbers are linked to asset in selected range. i.e. if there 4 serial no, then row should be split into 4 rows. The issue my code is that once I'm selected the range to be split, no matter that 3 or more serial numbers exist in first row it's slit into two rows, but the rest cells in range are split correctly. Not sure why the cycle within first cell in a range ends wrong.
Public Sub separate_line_range()
Dim target_col As Range
myTitle = "Select cells to be split"
Set target_col = Application.Selection
Set target_col = Application.InputBox("Select a range of cells that you want to split", myTitle, target_col.Address, Type:=8)
ColLastRow = target_col
Application.ScreenUpdating = False
For Each rng In target_col
If InStr(rng.Value, vbLf) Then
rng.EntireRow.Copy
rng.EntireRow.Insert
rng.Offset(-1, 0) = Mid(rng.Value, 1, InStr(rng.Value, vbLf) - 1)
rng.Value = Mid(rng.Value, Len(rng.Offset(-1, 0).Value) + 2, Len(rng.Value))
End If
Next
ColLastRow2 = target_col
For Each Rng2 In target_col
If Len(Rng2) = 0 Then
Rng2.EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
End Sub
Please find imagine below:
I don't exactly know your task, so I put something relatively close to your task.
The issue of not correctly loop through all row is because the "RNG" you selected will not be resized after each insert row.
e.g. You are selecting row A1:C20, and there are two row added. Now the #19 and #20 are now A21:C21 & A22:C22. But the RNG is still A1:C20. The final two row will not be within the loop.
To solve your issue,
Use For i = LastRow to First Row Step -1 (Next) instead of For Each (Loop)
Here is something I do similar to your task (What I believe)
Sub Insertrow()
Dim i As Integer
Dim Lastrow As Integer
Lastrow = Worksheets("FMS1").Cells(1, 12)
For i = Lastrow To 1 Step -1
If Worksheets("FMS1").Range("J" & i) <> Worksheets("FMS1").Range("J" & i + 1) Then
Worksheets("FMS1").Range("J" & i + 1).EntireRow.Insert
Else
End If
Next
End Sub
Imagine the following data
and the following code
Option Explicit
Public Sub SplitLineBreaksIntoCells()
Const MyTitle As String = "Select cells to be split" ' define it as constant
Dim TargetCol As Range
On Error Resume Next ' next line errors if user presses cancel
Set TargetCol = Application.InputBox("Select a range of cells that you want to split", MyTitle, Application.Selection.Address, Type:=8)
On Error GoTo 0
If TargetCol Is Nothing Then
' User pressed cancel
Exit Sub
End If
Dim iRow As Long
For iRow = TargetCol.Rows.Count To 1 Step -1 ' loop from bottom to top when adding rows or row counting goes wrong.
Dim Cell As Range ' get current cell
Set Cell = TargetCol(iRow)
Dim LinesInCell() As String ' split data in cell by line break int array
LinesInCell = Split(Cell.Value, vbLf)
Dim LinesCount As Long ' get amount of lines in that cell
LinesCount = UBound(LinesInCell) + 1
' insert one cell less (one cell can be re-used)
Cell.Resize(RowSize:=LinesCount - 1).EntireRow.Insert Shift:=xlShiftDown
' inert the values from the spitted array
Cell.Offset(RowOffset:=-LinesCount + 1).Resize(RowSize:=LinesCount).Value = Application.Transpose(LinesInCell)
Next iRow
End Sub
You will get this as result:
I have a file called "gar_nv", "nbrLines" is the number of lines ,defined in my code. I have given names to my columns. "listCol" is a function returning a list of these names.
I would like to set all empty cells to zero except the cells of the following columns: "GCFRRE", "GCDEP1", "GCDEP2", "GCDEP3", "GCTYC0", "GCTYC1", "GCTYC2", "GCTYC3","GCBAC0", "GCBAC1", "GCBAC2", "GCBAC3". Knowing I have thousands of rows, this code takes a long time to run. Is there a way to make it faster ?
Dim rng As Variant, i As Long
With gar_nv
For i = 1 To nbrLines - 1
For Each rng In ListCol
Select Case rng
Case "GCFRRE", "GCDEP1", "GCDEP2", "GCDEP3", _
"GCTYC0", "GCTYC1", "GCTYC2", "GCTYC3", _
"GCBAC0", "GCBAC1", "GCBAC2", "GCBAC3"
Case Else
If IsEmpty(.range(rng).Rows(i)) = True Then
.range(rng).Rows(i).Value = "0"
End If
End Select
Next rng
Next i
End With
Let's say your columns are named ranges like headers in the image:
You can do:
Sub test()
Application.ScreenUpdating = False
Dim rng As Range
Dim Listcol As Variant
Dim i As Long
Listcol = Array("A", "B", "C_", "D") 'list of all named ranges
For i = 0 To UBound(Listcol)
Select Case Listcol(i)
Case "B"
'we do nothing
Case Else
'we replace blanks with 0
Set rng = Range(Listcol(i)).SpecialCells(xlCellTypeBlanks)
rng.FormulaR1C1 = "=0" ' set them to 0
rng.Value = rng.Value 'replace formula with value
Set rng = Nothing
End Select
Next i
Erase Listcol
Application.ScreenUpdating = True
End Sub
Notice named range B has been excluded:
Looking for the best way to write the following code. I am currently struggling to make my code as simple and neat as possible. The code effectively takes a range and returns back the range which is non-empty.
Option Explicit
Sub ReturnNonEmptyRange()
Dim testBool As Boolean
Dim i As Long
testBool = True
For i = 2 To 10000:
If Range("G" & i) = "" Then
i = i - 1
testBool = False
End If
If testBool = False Then
Exit For
End If
Next i
MsgBox ("The range is G2:K" & i)
End Sub
Below is some sample code you can try.
The function LastUsedRow is not used, but I'm providing since it can be useful. This will return the last used row in your worksheet.
Using "Range" like you did above will assume you want to use active sheet. I always like to specify a workbook and a sheet so there is no ambiguity.
Sub Test()
' Start at row 1 and and stop when first blank cell found
Dim wks As Worksheet: Set wks = ThisWorkbook.Worksheets("Sheet1")
Dim row As Long
' Option 1: using column numbers
row = 1
Dim col As Long: col = 7 ' G
Do Until wks.Cells(row + 1, col).Value = ""
row = row + 1
Loop
MsgBox ("Last used row (in column): " & row) ' assumes something in row 1
' Option 2: using column letters
row = 1
Dim colLetter As String: colLetter = "G"
Do Until wks.Range(colLetter & row + 1).Value = ""
row = row + 1
Loop
MsgBox ("Last used row (in column): " & row) ' assumes something in row 1
End Sub
Public Function LastUsedRow(wks As Worksheet) As Long
Dim rng As Range: Set rng = wks.UsedRange ' Excel will recalc used range
LastUsedRow = rng.row + rng.Rows.Count - 1
End Function
I think your method only works if your none-empty range is consecutive. Suppose G2:G10 is non-empty, G11 is empty and G12:G20 is non-empty. Your code would come to i=11 and return G2:K10 as the non-empty range.
A more reliable, and quicker way to find the last non-empty cell (before row 1000) would be this:
range("G1000").End(xlUp).row
This will give you the first non-empty row in column G above row 1000. If row 1000 is non-empty however, it would search upwards for the last non-empty row. so you might want to change it to:
Range("G" & Rows.Count).End(xlUp).Row
This will find the last non-empty row, starting from the bottom of the worksheet.
How about combining the loop's exit conditions all into the loop control header.
I also would explicitly access the range()'s value to be more clear in the code and check the string length to be zero.
Option Explicit
Sub ReturnNonEmptyRange()
Dim testBool As Boolean
Dim i As Long
testBool = True
i = 2
While (i < 10000) And (Len(Range("G" & i).Value) <> 0)
i = i + 1
Wend
MsgBox ("The range is G2:K" & i)
End Sub
In the case this was an Array, one could not use Range("G" & Rows.Count).End(xlUp).Row. I believe #Siddharth provided a good solution. The downside being it will stop at a non- empty row.
Sub ReturnNonEmptyRange()
Dim i As Long
For i = 2 To 10000:
If Len(Trim(Range("G" & i).Value)) = 0 Then Exit For
Next i
MsgBox ("The range is G2:K" & i - 1)
End Sub
I am comparing two excelsheets in the same workbook.
I want to check whether the records from sheet1 are exactly same as records in sheet2 based on common Question_id(Column A of both worksheets)
This question_id(column A) has values such as
1
1a
1a.1
1a.1a
1a.1b
1a.1c
2
2a
2a.1
2a.1a
2a.1b
2a.1c etc....
I want to compare the records based on this Question_id(Column A Value).
If Question_id is same and records(the remaining row) are not same then am coloring those records in red background(only specific cells and not the whole row)
For the same, I have following code.
Sub RunCompare()
Call compareSheets("Sheet1", "Sheet2")
End Sub
Sub compareSheets(shtSheet1 As String, shtSheet2 As String)
Dim mycell As Range
Dim mydiffs As Integer
Application.ScreenUpdating = false
'Color Uncommon records in Red Background
For Each mycell In ActiveWorkbook.Worksheets(shtSheet2).UsedRange
If Not mycell.Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value Then
mycell.Interior.Color = vbRed
mydiffs = mydiffs + 1
End If
Next
'Display no. of differences
MsgBox mydiffs & " differences found", vbInformation
ActiveWorkbook.Sheets(shtSheet2).Select
MsgBox "Data Scrubbed Successfully..."
Application.ScreenUpdating = True
End Sub
The above code runs fine when I have same sequence of Question_id (and therefore of records) in both the excelsheets.
Assume I have different sequence of Question_id (and therefore of records) in both the sheets.
Then how I can achieve this...?
Something Like using where clause in my code Where Sheet1.Question_id = Sheet2.Question_id
i.e. I'll pick up question_id and the full row from sheet1 and I will compare it against records in sheet2 based on matching Question_id(value of Column A) only.
Can someone tell where I can put the condition and what type of condition so that, even if both the excelsheets have random sequences of Question_id; I will be able to compare the records from sheet1 and sheet2.
EDIT: on 23rd March 2015
I have changed the code using find() method instead of loops as below:
Still I havn't arrived at my solution.
Here am trying to list Question_Ids of all non-matching rows from sheet2 in sheet3 - Column A.
Option Explicit
Sub test()
Dim rng As Range, c As Range, cfind As Range, mycell As Range, cfindRow As Range
On Error Resume Next
Worksheets("Sheet3").Cells.Clear
With Worksheets("Sheet2")
Set rng = .Range(.Range("A2"), .Range("a2").End(xlDown))
For Each c In rng
With Worksheets("Sheet1")
Set cfind = .Columns("A:A").Cells.Find _
(what:=c.Value, lookat:=xlWhole)
'Find method always returns Range; So the following line should be something If cfind is not Nothing OR cfind <> Nothing (Both the syntaxes are wrong. Suggest me the right syntax please.
If cfind = 1 Then
'Here please tell me how to reference a whole row based on Column A value
'Here using cfind and again using mycell is something wrong as mycell variable again compares rows in sheet2 with rows in sheet1 which include Question_Id too.
Set mycell = ActiveWorkbook.Worksheets("Sheet2").UsedRange.End(xlDown)
'My both the excelsheets have values from columns A to AD. Still I want to make the code for all used Ranges of columns instead of only A to AD.
Set cfindRow = Worksheets("Sheet1").Rows("A2:AD").Cells.Find _
(what:=mycell.Value, lookat:=xlWhole)
'Find method always returns Range; So the following line should be something If cfindRow is not Nothing OR cfindRow <> Nothing (Both the syntaxes are wrong. Suggest me the right syntax please.
If cfindRow = 1 Then
'MsgBox "Match Found" 'Right Now do Nothing
End If
Else
' mycell.Interior.Color = vbRed
' mydiffs = mydiffs + 1
'Copy the question numbers to sheet3 either if they are new in new sheet (Sheet2) or content against them (in the whole row-any column value) is changed.
cfind.Copy Worksheets("sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
End With
Next c
Application.CutCopyMode = False
End With
MsgBox "Data Scrubbed Successfully..."
End Sub
Can someone tell me how to refer those ranges based on key column values?
My new approach towards solution:
(It may be a hint to give me answer on how to reference Row values based on key column)
Getting row indices of both the sheets; column A values
(Question_Id's) i.e.
c.Row and cfind.Row
Then
Check If(Sheet2.Cells(c.Row, Columns) = Sheet1.Cells(cfind.Row,
Columns) (To compare columns against matching Question_Ids only.)
So Finally this what all am trying to achieve :
1)Compare two sheets based on key column:
Pick up the Question_Id from Sheet2 - column A and compare it against column A in Sheet1. If the key columns from both the sheets match and also the contents against them(the complete row) matches- then Do nothing.
If the key column value(Question_Id - Column A) matches but values(Row) against it do not match them color those specific cells (Only cells) and not the whole row in Red background.
The Question_Id's which are there in sheet2 but not in sheet1 should be listed under first column in sheet3. Starting from A2.
The Question_Id's which are there in sheet1 but not in sheet2 should be listed under second column in sheet3. Starting from B2.
I am basing my code off of your first approach, because I found it simpler and more readable than the second approach.
We'll just do the most naive algorithm, which is to iterate through every row in the used range of both worksheets. (The fastest algorithm would probably be to sort both ranges in memory and then compare, but simplicity of code over performance optimization for now.)
Sub compareSheets(shtSheet1 As String, shtSheet2 As String)
Dim range1 As Range, range2 as Range
Dim mydiffs As Integer, row1 As Integer, row2 As Integer, col As Integer
Application.ScreenUpdating = False
'First create the two ranges we will be using
Set range1 = ActiveWorkbook.Worksheets(shtSheet1).UsedRange
Set range2 = ActiveWorkbook.Worksheets(shtSheet2).UsedRange
'Iterate through the rows of both ranges
For row1 = 1 To range1.Rows.Count
For row2 = 1 To range2.Rows.Count
'Only process the ranges if they share a common key in column 1
If range1.Cells(row1, 1) = range2.Cells(row2, 1) Then
'If they share the same key, iterate through columns and compare
For col = 1 To WorksheetFunction.Max(range1.Columns.Count, range2.Columns.Count)
If Not range1.Cells(row1, col).Value = range2.Cells(row2, col).Value Then
range1.Cells(row1, col).Interior.Color = vbRed
range2.Cells(row2, col).Interior.Color = vbRed
mydiffs = mydiffs + 1
End If
Next
End If
Next
Next
'Display no. of differences
MsgBox mydiffs & " differences found", vbInformation
Application.ScreenUpdating = True
End Sub
There are some specifications I wasn't sure of. For example, what if a key is in one spreadsheet but not the other? Should it be colored red in the sheet where it exists?
Nevertheless, I think the above code should give you a good start to address your more conceptual questions, and I'm happy to help adjust as needed, so please comment if there are specific requirements I'm missing.
Update 1
Here's the update code after our discussion in chat (link in comments), which takes the unmatched keys from the full outer join and copies them to a third sheet.
Sub compareSheets(shtSheet1 As String, shtSheet2 As String, shtSheet3 As String)
Application.ScreenUpdating = False
Dim range1 As Range, range2 As Range
Dim myDiffs As Integer, row1 As Integer, row2 As Integer, col As Integer
Dim sheet3index1 As Integer, sheet3index2 As Integer, i As Integer
Dim leftKeyMatched As Boolean 'Boolean to keep track of whether the key in sheet1 has a match as we are looping
Dim rightKeysMatched() As Boolean 'Array to keep track of which keys in sheet2 have matches
Set range1 = ActiveWorkbook.Worksheets(shtSheet1).UsedRange
Set range2 = ActiveWorkbook.Worksheets(shtSheet2).UsedRange
ReDim rightKeysMatched(range2.Rows.Count)
For row1 = 1 To range1.Rows.Count
leftKeyMatched = False
For row2 = 1 To range2.Rows.Count
If range1.Cells(row1, 1) = range2.Cells(row2, 1) Then
'We have a match, so mark both sides as matched
leftKeyMatched = True
rightKeysMatched(row2 - 1) = True 'This -1 is because the array indexing starts at 0 but the rows in the spreadsheet start at 1
For col = 1 To WorksheetFunction.Max(range1.Columns.Count, range2.Columns.Count)
If Not range1.Cells(row1, col).Value = range2.Cells(row2, col).Value Then
range1.Cells(row1, col).Interior.Color = vbRed
range2.Cells(row2, col).Interior.Color = vbRed
myDiffs = myDiffs + 1
End If
Next
End If
Next
'Print out the key from sheet1 if it didn't find a match in sheet2
If leftKeyMatched = False Then
sheet3index1 = sheet3index1 + 1
ActiveWorkbook.Worksheets(shtSheet3).Cells(sheet3index1, 1) = range1.Cells(row1, 1)
End If
Next
'Now print out any key that still hasn't been matched in sheet2
For i = 0 To range2.Rows.Count
If rightKeysMatched(i) = False Then
sheet3index2 = sheet3index2 + 1
ActiveWorkbook.Worksheets(shtSheet3).Cells(sheet3index2, 2) = range2.Cells(i + 1, 1) '+1 for same reason as above, index starts at 0 versus 1
End If
Next
'Display no. of differences
'MsgBox myDiffs & " differences found", vbInformation
Application.ScreenUpdating = True
End Sub
I'll take a crack at this
Sub compareSheets(shtSheet1 As String, shtSheet2 As String)
Dim mycell As Range
Dim mydiffs As Integer
Dim ws1 as WorkSheet
Dim ws2 as WorkSheet
Dim rng as Range
Dim SourceRow as integer
Dim Col as integer
set ws1 = ActiveWorkbook.Worksheets(shtSheet1)
set ws2 = ActiveWorkbook.Worksheets(shtSheet2)
myDiffs = 0
'Application.ScreenUpdating = false 'enable this later, once it's all working
'Color Uncommon records in Red Background
'your key is in column A, so we'll only loop through that column
For sourceRow = 1 to ws2.usedrange.Rows.Count
set rng = ws1.range(ws1.address).find(what:=ws2.cells(sourcerow, 1), LookIn:=xlValues, _
LookAt=xlWhole, MatchCase:=False)
'making an assumption on MatchCase, change as needed
if not rng is Nothing then 'we found the key, now let's look at the rest of the row
col = 2
'loop through the rest of the columns for this row
while col < ws2.usedRange.Columns.Count
'if the cell in the row we just found on sheet1 <> the cell that we were looking for from sheet2
if rng.cells(1,col) <> ws2.cells(sourcerow,col) then
rng.cells(1,col).Interior.Color = vbRed
mydiffs = mydiffs+1
end if
col = col + 1
wend
else
'we didn't find the key. pop up a msgbox. you may want something else
MsgBox ("Sheet2 key: " & ws1.value & " not found on Sheet1")
end if
'Display no. of differences
MsgBox mydiffs & " differences found", vbInformation
ActiveWorkbook.Sheets(shtSheet2).Select
MsgBox "Data Scrubbed Successfully..."
Application.ScreenUpdating = True
End Sub
If you want to find a value in a range use the following:
.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
Like this :
Application.ScreenUpdating = False
'On Error Resume Next 'Err.Numbers 9, 91 => Find: value not found
Dim findCell as range
ActiveWorkbook.Worksheets(shtSheet2).Select
ActiveWorkbook.Worksheets(shtSheet2).UsedRange.Select
'Color Uncommon records in Red Background
For Each mycell In ActiveWorkbook.Worksheets(shtSheet1).UsedRange
Set findCell = Selection.Find(What:=Trim(mycell.value & ""), LookIn:=xlValues)
If findCell Is Nothing Then
mycell.Interior.Color = vbRed
mydiffs = mydiffs + 1
End If
Next
Note :
Please change Application.ScreenUpdating = True to Application.ScreenUpdating = False
And for more information use this MSDN article
And for using a function like that you want:
Public Function look_up_id (r as Range) As Variant
'
'Function body
'
End Function
'....
Call look_up_id(ActiveWorkbook.Worksheets(shtSheet2).Range("A:A", table))
'....
Im trying to write / find a macro that when ran removes the value in a cell if the cells in the column is not a number. IE remove all the cells in column B if a string is found. I have this script to delete empty rows.
Was just trying to re write it so that it can delete the rows based on these condiitions
Sub RemoveRows()
Dim lastrow As Long
Dim ISEmpty As Long
lastrow = Application.CountA(Range("A:XFD"))
Range("A1").Select
Do While ActiveCell.Row < lastrow
ISEmpty = Application.CountA(ActiveCell.EntireRow)
If ISEmpty = 0 Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub
The code iterates backward from the last cell in column B and checks if the value in the cell is numeric using the IsNumeric() function.
If the value is not numeric then it deletes the entire row.
Note: looping backwards (ie. from the last row to first) is necessary when using a loop because the index gets shifted everytime a row gets deleted. Therefore, to avoid skipping some rows backward iteration is required.
Sub KeepOnlyNumbers()
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
Dim i As Long
' iterating backwards (from last row to first to keep the logic flow)
For i = ws.Range("B" & ws.Rows.Count).End(xlUp).Row To 1 Step -1
' check whether the value is numeric
If Not IsNumeric(Range("B" & i)) Then
' if not numeric then clear the cells content
Range("B" & i).ClearContents
End If
Next i
Application.ScreenUpdating = True
End Sub
You can use IsNumeric to evaluate if an object can be evaluated as a number. So you can add:
If Not IsNumeric(ActiveCell) Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
to your Do While loop and it should do what you want. I haven't tested this; let me know if you get an error.
You do not have to iterate backwards even when deleting rows, you can do union and call delete/clear on the unioned range.
Sub UnionOnCondition()
Dim usedColumnB
Set usedColumnB = Intersect(ActiveSheet.UsedRange, _
ActiveSheet.Columns("b"))
If usedColumnB Is Nothing Then _
Exit Sub
Dim result: Set result = Nothing
Dim cellObject
For Each cellObject In usedColumnB
' skip blanks, formulas, dates, numbers
If cellObject = "" Or _
cellObject.HasFormula Or _
IsDate(cellObject) Or _
IsNumeric(cellObject) Then GoTo continue
If result Is Nothing Then
Set result = cellObject.EntireRow
Else
Set result = Union(result, cellObject.EntireRow)
End If
continue:
Next
If Not result Is Nothing Then _
result.Select ' result.Clear or result.Delete
End Sub