Consulting

Results 1 to 4 of 4

Thread: Solved: Display currency value in red

  1. #1

    Solved: Display currency value in red

    I have this code that imports information into my sheet. In columns I & J, currency values are entered. If the currency value in column I or J is $0.00, i would like this value to display in red. Can anyone assist. Thank you.

    [VBA]Private Sub Import_Trip(txtFile)
    Dim txt As String, w(), i As Long, d As Date, X, Y
    Dim fs As Object, mNo As Long, Months
    Dim Pos As Long
    Dim Old_Date As Integer 'day number in month
    Dim Start_Time As Date
    Dim strD_End As String
    Dim strAirport As String
    Dim My_Day As Integer
    Dim M_IE_Rate As Single
    Dim Transportation_Rate As Single
    Dim Temp_Country As Integer
    Dim Temp_Time As Variant
    Dim str_Cty_Temp As String
    Dim Temp_R As Range
    Dim Temp_R2 As Range
    'routine to import Flight log data and record as an expense on the sheet
    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(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
    w(Pos, 9) = Transportation_Rate
    If Range("AN13") > 0 Then
    If Start_Time = "00:00" And strD_End = "24:00" Then
    w(Pos, 10) = Range("AN13") * 2
    Else
    w(Pos, 10) = 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
    TextBox1 = ""
    Paste.Caption = "Paste"
    ClearClipboard
    With ActiveSheet
    i = .Range("B250").End(xlUp).Row
    If i < 10 Then i = 10
    On Error GoTo EH
    Application.EnableEvents = False
    .Unprotect "T0nyul!a"
    Set Temp_R = .Cells(i + 1, 1).Resize(UBound(w, 1), UBound(w, 2) + 1)
    Temp_R = w
    Temp_R.Columns(4).NumberFormat = "[H]:MM"
    For Each Temp_R2 In Temp_R.Columns(5).Rows
    If Temp_R2.Value <> 1 Then
    Temp_R2.Offset(, -3).NumberFormat = "MM/DD/YY""*"""
    Else
    Temp_R2.Offset(, -3).NumberFormat = "MM/DD/YY"
    End If
    Next
    Application.EnableEvents = True
    Range("B11:L250").Sort Key1:=Range("B11"), Order1:=xlAscending, Header:=xlNo
    Cells(Range("B251").End(xlUp).Row + 1, 1).Activate
    .Protect "T0nyul!a"
    End With
    Exit Sub
    EH:
    MsgBox "The importing data is not correctly formatted or a layover has not" & vbLf & _
    "occurred in one of the importing trip. Make sure the data is correctly" & vbLf & _
    "formatted and each trip are a multi-day trip.", vbExclamation
    End Sub[/VBA]

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,729
    Location
    [vba]
    Range("a1").Value = 0
    Range("a1").NumberFormat = "$#,##0.00_);($#,##0.00);[red]$0.00_)"
    [/vba]

    Paul

  3. #3
    Thank you Paul, but i manage to achieve what I need to accomplish with conditional formatting.

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Why use CF< why not just custom formatting (the format is in Paul's answer)?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •