PDA

View Full Version : Solved: Red Font



av8tordude
07-04-2011, 12:33 PM
The code below will enter either $0.00 or a currency number in column 8 row or column 9. How can I make the font display red when it enters $0.00? I've tried this peice in red, but it doesn't like it..

If w(Pos, 8) = "$0.00" Then
Font.Color = 255
Else
Font.Color = 0
End If


On Error GoTo EH
Months = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
Set fs = CreateObject("scripting.filesystemobject")
txt = TextBox1
X = Split(txt, vbCrLf)
ReDim w(1 To UBound(X), 11)

Pos = 1
Old_Date = 0
For i = 0 To UBound(X)
Y = Split(X(i), " ")
If UBound(Y) > 6 Then
If Y(0) Like "?#**#?" Then
mNo = Application.Match(Right$(Y(2), 3), Months, 0)
Start_Time = Left(Y(9), 2) & ":" & Mid(Y(9), 3, 2) 'BSE REPT:
End If

If InStr(1, Join(Y), "D-END:", vbBinaryCompare) * InStr(1, Join(Y), "T.A.F.B", vbBinaryCompare) Then
strD_End = Left(Y(3), 2) & ":" & Mid(Y(3), 3, 2)
Else
strD_End = "24:00"
End If

'an airport IATA is identified in the record as follows -
'4 digit number before IATA
'3 character IATA in uppercase between A an Z or digits 0 to 9
'4 difit number after IATA

If (Y(UBound(Y) - 3) Like "####" And _
(Y(UBound(Y) - 2) Like "[0-9,A-Z][0-9,A-Z][0-9,A-Z]") And _
Y(UBound(Y) - 1) Like "####") Or _
strD_End <> "24:00" Then
If strD_End = "24:00" Then
strAirport = Y(UBound(Y) - 2)
My_Day = Y(1)
Else
Y = Split(X(i - 1), " ")
My_Day = Y(1)
End If
If My_Day < Old_Date Then 'new month
mNo = mNo + 1
If mNo = 13 Then Exit For ' dont import anything for new (next) year.
End If
d = DateSerial(Year(ActiveSheet.Range("B7")), mNo, My_Day)
w(Pos, 1) = Format(d, "MM/DD/YY")
w(Pos, 2) = Format(Start_Time, "HH:MM")
w(Pos, 3) = strD_End
If strD_End = "24:00" Then
w(Pos, 4) = 1 - CSng(TimeSerial(Hour(w(Pos, 2)), Minute(w(Pos, 2)), 0))
Else
w(Pos, 4) = CSng(TimeSerial(Hour(w(Pos, 3)), Minute(w(Pos, 3)), 0)) - CSng(TimeSerial(Hour(w(Pos, 2)), Minute(w(Pos, 2)), 0)) 'total
End If
w(Pos, 4) = IIf(w(Pos, 4) = "1", "24:00", Format(w(Pos, 4), "HH:MM"))
w(Pos, 6) = strAirport
If Application.CountIf(Range("ICAO_TABLE").Columns(1), strAirport) > 0 Then
If Trim(UCase(Application.VLookup(strAirport, Range("ICAO_TABLE"), 3, False))) = "UNITED STATES" Then
str_Cty_Temp = Application.VLookup(strAirport, Range("ICAO_TABLE"), 4, False)
If InStr(1, str_Cty_Temp, "(") > 0 Then
str_Cty_Temp = Trim(Left(str_Cty_Temp, InStr(1, str_Cty_Temp, "(") - 1))
End If
w(Pos, 7) = str_Cty_Temp & ", " & Application.VLookup(strAirport, Range("ICAO_TABLE"), 5, False)
Temp_Country = 1
Else
str_Cty_Temp = Application.VLookup(strAirport, Range("ICAO_TABLE"), 4, False)
If InStr(1, str_Cty_Temp, "(") > 0 Then
str_Cty_Temp = Trim(Left(str_Cty_Temp, InStr(1, str_Cty_Temp, "(") - 1))
End If
w(Pos, 7) = str_Cty_Temp & ", " & _
Application.VLookup(strAirport, Range("ICAO_TABLE"), 3, False)
Temp_Country = 2
End If
Else
Temp_Country = 1 'assume it is a domestic airport if it doesnt exist in the database during import
w(Pos, 7) = ""
End If
If w(Pos, 4) = "24:00" Then
Temp_Time = 1
Else
Temp_Time = TimeValue(w(Pos, 4))
End If
w(Pos, 5) = Format(Reimb_Rate(CLng(CDate(w(Pos, 1))), Temp_Country) * 24 * Temp_Time, "$0.00")
If w(Pos, 7) <> "" Then 'airport was found, check country of Airport IATA code.
'you can only calculate M_IE rates, transportation rates and per diem rates if you know the country/city/state for the IATA
'leave the rates blank of the IATA wasnt found.
'calculate m_ie_rate and transportation rates for this row.
Call Calc_Rates2(w, Pos, M_IE_Rate, Transportation_Rate)
w(Pos, 8) = M_IE_Rate
If w(Pos, 8) = "$0.00" Then
Font.Color = 255
Else
Font.Color = 0
End If
w(Pos, 9) = Transportation_Rate
If ActiveSheet.Range("AN13") > 0 Then
If Start_Time = "00:00" And strD_End = "24:00" Then
w(Pos, 10) = ActiveSheet.Range("AN13") * 2
Else
w(Pos, 10) = ActiveSheet.Range("AN13")
End If
w(Pos, 11) = "Airport Shuttle Tips"
End If
End If
Pos = Pos + 1
Start_Time = 0
Old_Date = My_Day
End If
End If
Next

CharlesH
07-04-2011, 12:47 PM
HI,

NS but I think you need to set the code too.




''' Value or Text '''
If w(Pos, 8).Value = "$0.00" Then
Font.Color = 255
Else
Font.Color = 0
End If

av8tordude
07-04-2011, 12:52 PM
That didn't work, but I figure I would try getting the cell to make the font display red, but didn't like that either

If M_IE_Rate = "$0.00" Then
w(Pos, 8).Font.Color = 255
Else
w(Pos, 8).Font.Color = 0
End If

CharlesH
07-04-2011, 12:57 PM
This worked for me.


If Range("A1").Value = "0" Then''' note the "0" and not "0.00"
Range("A1").Font.Color = 255
End If

mikerickson
07-04-2011, 01:04 PM
Use the custom number format

$#,##0.00;[Red]$#,##0.00;[Red]$0.00

in the cell

av8tordude
07-04-2011, 01:17 PM
Hi Mike,

Unfortunately, I already have custom formatting in the cells $###0.00"*". Unless I can create multiple custom formatting?

mikerickson
07-04-2011, 01:24 PM
Try
$#,##0.00"*";[Red]$#,##0.00"*";[Red]$0.00

The semi-colons allow different formatting for different kinds of data

greater than 0 ; less than 0 ; =0 ; text

So with that format
1034.12 would show as $1,034.12*
-35.00 would show as $35.00*
and 0 would show as $0.00

av8tordude
07-04-2011, 04:14 PM
Thank you Charles & Mike for your help. Mike your last suggestion did the trick.