VBA To Conditionally format text

sdel_nevo

New Member
Joined
Jan 16, 2015
Messages
28
Hi Guys

I am using this code on an access forms on click event to export data to excel

the code below works really well and setup the layout of my worksheet as required

Code:
 Dim xlApp As Object
   Dim xlBook As Object
   Dim xlSheet As Object
   Dim SQL As String
   Dim Rs1 As DAO.Recordset
   Dim iRowStart As Integer
   Const xlCenter = -4108
   Const xlleft = -4131 'xlRight is -4152
   Const xlCellValue = 1
   Const xlGreater = 5
   '    Const xlExpression = 2


   Dim oObj As Object

   On Error Resume Next
   Set xlApp = GetObject(, "Excel.Application")
   If Err.Number <> 0 Then
      ' No Outlook is not open, try and create object
      Err.Clear
      Set oObj = CreateObject("Excel.Application")
      If Err.Number <> 0 Then

         MsgBox "Excel Is Either Not Installed Or Is Unavalible You Can Not Export To Excel"
         Err.Clear

         Exit Sub
      End If
   End If

   SQL = "SELECT tblTechRequests.TechRequestNumber AS [TR Number], tblTechRequests.DaysDate AS [TR Raised On], " & _
      "tblTechRequests.DueByDAte AS [Due By], tblTechRequests.FirstResponceDAte AS [First Responded On], " & _
      "tblTechRequests.AuthorsName AS [Raised By], tblTechRequests.MachineName AS [Machine Name], " & _
      "tblTechRequests.PartNumber AS [Part Number], tblTechRequests.ReasonForTR AS [Reason For TR], " & _
      "tblTechRequests.Status, tblTechRequests.TRWatingTechnicalTime AS [Time Waiting Technical], " & _
      "tblTechRequests.TRClosureTime AS [TR Closure Time], tblTechRequests.TRMachineDownTime AS [Machine Down Time] FROM tblTechRequests"


   'Execute query and populate recordset
   Set Rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)

   'If no data, don't bother opening Excel, just quit
   If Rs1.RecordCount = 0 Then
      MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
      Exit Sub
   Else
      'We Shall Turn On The Hour Glass, So That Users Know That Something Is Happening
      DoCmd.Hourglass (True)

      'Create an instance of Excel and start building a spreadsheet Late Binding Used So No References Required
      Set xlApp = CreateObject("Excel.Application")

      xlApp.Visible = False
      Set xlBook = xlApp.Workbooks.Add() 'start a new workbook
      Set xlSheet = xlBook.Worksheets(1)

      With xlSheet
         .Name = "Technical Request Data"
         .Cells.Font.Name = "Franklin Gothic Book"
         .Cells.Font.Size = 10

         'Format range as required To Bold a Cell use this for example .Range("A1").Cells.Font.Bold = True
         .Range("A1", "H1").Merge
         .Range("A1").Columns.AutoFit
         .Range("A2", "H2").Merge
         .Range("A2").Columns.AutoFit
         .Range("A1").HorizontalAlignment = xlleft
         .Range("A2").HorizontalAlignment = xlleft
         .Range("A1").Cells.Font.Name = "Franklin Gothic Book"
         .Range("A2").Cells.Font.Name = "Franklin Gothic Book"
         .Range("A1").Cells.Font.Size = 12
         .Range("A2").Cells.Font.Size = 10
         .Range("A1").Value = DLookup("[CompanyName]", "[tblSettings]", "[ID]=1") & "  " & "Technical Request System Data " '= "Company Aged Creditors Report"
         .Range("A2").Value = "Exported ON" & " - " & Date

         'Now We Shall Build The Colum Headings.value is the text required
         .Range("A4").Value = "TR Number"
         .Range("B4").Value = "TR Raised On"
         .Range("C4").Value = "Due By"
         .Range("D4").Value = "First Responded On"
         .Range("E4").Value = "Raised By"
         .Range("F4").Value = "Machine Name"
         .Range("G4").Value = "Part Number"
         .Range("H4").Value = "Reason For TR"
         .Range("i4").Value = "Status"
         .Range("j4").Value = "Time Waiting Technical"
         .Range("k4").Value = "TR Closure Time"
         .Range("l4").Value = "Machine Down Time"

         'Format Column Headings set the text to the left on A4 so it looks nice, then center the values in the range B7:G3000 so all values are centered
         .Range("A4:l4").Cells.Font.Bold = True
         .Range("A4:l4").HorizontalAlignment = xlCenter
         .Range("A4:l4").Columns.AutoFit
         
         'Format using these examples .Columns("A").NumberFormat = "$#,##0.00;-$#,##0.00"
         .Columns("D").NumberFormat = "dd/mm/yyyy"
         .Columns("C").NumberFormat = "dd/mm/yyyy"
        
         'iRowStart is the row that the starting row that the recordset will enter data into
         iRowStart = 7
         'Then we Loop through recordset above and copy data from recordset until we get to the end of file
         Do While Not Rs1.EOF

            'start importing the data from the record set above into the required columns A,B,C,D,E,F,G in this example
            .Range("A" & iRowStart).Value = Nz(Rs1![TR Number], "")
            .Range("A" & iRowStart).Columns.AutoFit
            .Range("A" & iRowStart).HorizontalAlignment = xlCenter
            .Range("A" & iRowStart).ColumnWidth = 15

            .Range("B" & iRowStart).Value = Nz(Rs1![TR Raised On], "")
            .Range("B" & iRowStart).Columns.AutoFit
            .Range("B" & iRowStart).HorizontalAlignment = xlCenter
            .Range("B" & iRowStart).ColumnWidth = 18

            .Range("C" & iRowStart).Value = Nz(Rs1![Due By], 0)
            .Range("C" & iRowStart).Columns.AutoFit
            .Range("C" & iRowStart).HorizontalAlignment = xlCenter
            .Range("C" & iRowStart).ColumnWidth = 15
                      
            .Range("D" & iRowStart).Value = Nz(Rs1![First Responded On], 0)
            .Range("D" & iRowStart).Columns.AutoFit
            .Range("D" & iRowStart).HorizontalAlignment = xlCenter
            .Range("D" & iRowStart).ColumnWidth = 20

            .Range("E" & iRowStart).Value = Nz(Rs1![Raised By], 0)
            .Range("E" & iRowStart).Columns.AutoFit
            .Range("E" & iRowStart).HorizontalAlignment = xlCenter
            .Range("E" & iRowStart).ColumnWidth = 15

            .Range("F" & iRowStart).Value = Nz(Rs1![Machine Name], 0)
            .Range("F" & iRowStart).Columns.AutoFit
            .Range("F" & iRowStart).HorizontalAlignment = xlCenter
            .Range("F" & iRowStart).ColumnWidth = 20

            .Range("G" & iRowStart).Value = Nz(Rs1![Part Number], 0)
            .Range("G" & iRowStart).Columns.AutoFit
            .Range("G" & iRowStart).HorizontalAlignment = xlCenter
            .Range("G" & iRowStart).ColumnWidth = 20

            .Range("H" & iRowStart).Value = Nz(Rs1![Reason For TR], 0)
            .Range("H" & iRowStart).Columns.AutoFit
            .Range("H" & iRowStart).HorizontalAlignment = xlCenter
            .Range("H" & iRowStart).ColumnWidth = 28

            .Range("I" & iRowStart).Value = Nz(Rs1![Status], 0)
            .Range("I" & iRowStart).Columns.AutoFit
            .Range("I" & iRowStart).HorizontalAlignment = xlCenter
            .Range("I" & iRowStart).ColumnWidth = 20

            'Column J,K and L do not need the width set as the colum header is wider than the dasta bening entered
            .Range("J" & iRowStart).Value = Nz(Rs1![Time Waiting Technical], 0)
            .Range("J" & iRowStart).HorizontalAlignment = xlCenter
            
            .Range("K" & iRowStart).Value = Nz(Rs1![TR Closure Time], 0)
            .Range("K" & iRowStart).HorizontalAlignment = xlCenter

            .Range("L" & iRowStart).Value = Nz(Rs1![Machine Down Time], 0)
            .Range("L" & iRowStart).HorizontalAlignment = xlCenter

            iRowStart = iRowStart + 1
            Rs1.MoveNext
         
                 
         
         Loop

      
         'then we set a footer, we start this two rows below the last entry and leave a gap of 3 rows and format the footer nicely
         iRowStart = iRowStart + 2
         .Range("A" & iRowStart).Value = "All Data Exported From The Technical Request System."
         .Range("A" & iRowStart).Font.Color = vbRed
         .Range("A" & iRowStart).HorizontalAlignment = xlleft
         .Range("A" & iRowStart).Cells.Font.Bold = True
      End With

      DoCmd.Hourglass False
      xlApp.Visible = True
      Rs1.Close
      Set Rs1 = Nothing
      Set xlApp = Nothing
      Set xlBook = Nothing
      Set xlSheet = Nothing

      On Error GoTo 0
      Exit Sub
   End If

how ever, i cant get my head around how to use conditoinal formatting,

basically what i want to do so change the text colour of all dates in the range .Range("C" & iRowStart).Value to red if the date exported is less than or equal to todays date

really sorry if this has been asked before

Many thanks

Steve
 

Some videos you may like

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

sdel_nevo

New Member
Joined
Jan 16, 2015
Messages
28
Hi Guys

All sorted

used this code

Code:
.Range("C" & iRowStart).Value = Nz(Rs1![Due By], 0)
            .Range("C" & iRowStart).Columns.AutoFit
            .Range("C" & iRowStart).HorizontalAlignment = xlCenter
            .Range("C" & iRowStart).ColumnWidth = 15
            
            'now apply conditional formatting as required
            With .Range("C" & iRowStart).FormatConditions.Add(xlCellValue, xlLessEqual, Date)
               .Font.Color = vbRed
            End With
 

Watch MrExcel Video

Forum statistics

Threads
1,127,864
Messages
5,627,338
Members
416,242
Latest member
Kas O

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top