ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   VB to color text (https://www.excelbanter.com/excel-programming/357377-vbulletin-color-text.html)

[email protected]

VB to color text
 
I know very little VB. I just copy/paste/modify to make it work, so I'm
sure this isn't the most efficient code. I have the following code in
a module to search for a string in Col A and format the text in the row
red. If the string in Col A isn't found, it adds that string to a
blank cell and then selects the next cell to the right and adds another
specific string (that hooks to a vlookup formula) and formats text red.
Where I am stuck is when I want to reverse this in another macro. I
can get it to search for the string and change the text back to black.
But what I want to do is if it finds a cell in Col A and if the value
in the cell to the right is "OTS", then in addition to formatting the
row text back to black, I want it to offset 2, 3 and 6 cells right and
ClearContents.
The code comments are for my use to help me remember what it all does.
Any advise would be appreciated.

Sub AcftOutOfService()
Dim c As Range
Dim Findstr As String
Findstr = InputBox("ENTER AIRCRAFT NUMBER TO REMOVE FROM SERVICE",_
"AIRCRAFT OUT OF SERVICE")
ActiveSheet.Unprotect
With Range("a1:a75")
Set c = .Find(Findstr, LookIn:=xlValues, Lookat:=xlWhole)
'Search for the aircraft number in Col A
If c Is Nothing Then
'If the aircraft doesn't exist in the range, then go to the
'first blank cell in the column and add the aircraft number,
'then format the text and add "OTS" which is our "out of
'service" marker.
Range("A3").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
Selection.EntireRow.Cells.Font.ColorIndex = 3
Selection.EntireRow.Cells.Font.Italic = True
Selection.Cells.Value = Findstr
Selection.Offset(0, 1).Select
Selection.Cells.Value = "OTS"
Else 'If the aircraft already exists in Col A, then we find all
'the cells containing that aircraft and format the text in
'the entire row.
firstAddress = c.Address
Do
c.EntireRow.Cells.Font.ColorIndex = 3
c.EntireRow.Cells.Font.Italic = True
Set c = .FindNext(c) 'Look for next occurence of search
'string
Loop While c.Address < firstAddress
End If
End With
ActiveSheet.Unprotect '...for some reason, the unprotect above
'isn't working...I get sheet protection
'error when it gets here if it is an
'aircraft that does not exist. So I added
'another unprotect
Selection.SpecialCells(xlCellTypeBlanks).Select
'Select all the blank cells in the sheet and make sure they are
'formatted font black
Selection.Font.ColorIndex = 1
Selection.Font.Italic = False
ActiveSheet.Protect
ActiveWorkbook.Save
Range("A3").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
'Now pop up a message that says what time the aircraft was taken out
'of service. The user can click OK, or it will close after 5 seconds
CreateObject("WScript.Shell").Popup "Aircraft " & Findstr & " out _
of service at " & Time, 5, "AIRCRAFT OUT OF SERVICE"
End Sub



All times are GMT +1. The time now is 07:46 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com