I am looking for a simple macro to use in Excel 2003 to delete rows in
a worksheet that do not have text that is highlighted.  If it is
easier the macro could delete rows that do not have any bold text in
them.  I have been identifying the rows that I want to keep by running
a find/replace on the words I am looking for, and replacing them with
the same work but highlighted in yellow.  This allows me to easily
spot the rows that I want to keep, but I have to manually select and
delete the rows that don't show any highlighted text (in yellow).

Thanks,

Mike

---

Clarification of Question by gotmike-ga on 01 Nov 2005 19:46 PST

The third sentence in my question should read "the same word" not "the
same work".   Please feel free to ask if you have any questions about
what I am trying to do.  The macro should scan the rows and delete the
ones that do not contain text that is either highlighted in yellow (or
text that is in bold if that is simpler).

Thanks,

Mike

---

Clarification of Question by gotmike-ga on 03 Nov 2005 11:46 PST

I figured it out.  Thanks again for your help.

--Mike

Following procedures that I made is not delete from the original it
copy the wanted rows to next sheet. You can edit these to what you
want

' this is bold test to make sure the right row that you want to delete
Sub boldtest()
    MsgBox ThisWorkbook.Sheets(1).Rows(1).Font.FontStyle
    MsgBox ThisWorkbook.Sheets(1).Cells(1, 2).Value
End Sub

' this is color test to make sure the right row that you want to delete
Sub colortest()
    MsgBox ThisWorkbook.Sheets(1).Rows(9).Interior.Color
    MsgBox ThisWorkbook.Sheets(1).Cells(9, 1).Value
    '65535 is yellow color
End Sub

' copy original sheet to new one with removing all unwanted
Sub CopyToNewSheet()
i = 1  'line count on original sheet
x = 1  'line count on new sheet
Do Until ThisWorkbook.Sheets(1).Cells(i, 1).Value = "" 'checking the end of rows
If ThisWorkbook.Sheets(1).Rows(i).Interior.Color <> 65535 Then ' you
can change here yellow or bold
    ThisWorkbook.Sheets(2).Rows(x).Value = ThisWorkbook.Sheets(1).Rows(i).Value
    x = x + 1 'move to next new line
End If
i = i + 1 'move to next line
Loop
MsgBox "done! All records " & x & " copy to sheet2"
End Sub


This is not answer just comment

Thanks for the great response.  With some tweaking I was able to get
the color based macro to work, but it only copies rows that are
highlighted in yellow in their entirety.  If you could submit your
script as an answer with some minor changes to copy over rows that
have any cell highlighted I would gladly accept it.  In my spreadsheet
only certain cells are highlighted, and I need to copy over any rows
that have one or more highlighted cells in them.

Thanks in advance.

--Mike

I'm very glad to here that I submitted script is usefull/reference to you,
You can use this script under GNU :D Just Kidding I'll not submit as
an answer, actually I'm not vb guy and
no good at english too.

sithu

Could you help with the problem I am having regarding copying rows
that only have one or more cells highlighted.  The script that you
wrote is great, but it only works if the whole row is highlighted in
yellow.  I need it to copy rows that have  only one (or a few) cells
highlighted in yellow.

Thanks so much for your help.  Your english seems pretty good to me :)

--Mike

This following procedure and function can fullfill your requirement
you only need to run CopyToNewSheet procedure it will call the
function CheckColorInRow to check the color exit in each row

Sub CopyToNewSheet()
i = 1  'line count on original sheet
x = 1  'line count on new sheet
Do Until ThisWorkbook.Sheets(1).Cells(i, 1).Value = "" 'checking the end of rows
If CheckColorInRow(i) = True Then ' check current row have colored field
    ThisWorkbook.Sheets(2).Rows(x).Value = ThisWorkbook.Sheets(1).Rows(i).Value
    x = x + 1 'move to next new line in new sheet
End If
i = i + 1 'move to next line in original sheet
Loop
MsgBox "done! All records " & x & " copy to sheet2"
End Sub

Function CheckColorInRow(RowsNo) As Boolean
y = 1 ' column count
Do Until ThisWorkbook.Sheets(1).Cells(RowsNo, y).Value = ""
If ThisWorkbook.Sheets(1).Cells(RowsNo, y).Interior.Color <> 16777215
Then ' checking the uncolored cell
    CheckColorInRow = True
    Exit Function
End If
y = y + 1
Loop
CheckColorInRow = False
End Function

If your row have two or more colored cells and you only need is yellow then
change the color number in this line according to your requirement

For eg.

If ThisWorkbook.Sheets(1).Cells(RowsNo, y).Interior.Color <> 16777215 Then

to

If ThisWorkbook.Sheets(1).Cells(RowsNo, y).Interior.Color = 65535 Then