Export to Excel module-Need formatting help please-Coloring Cells 1

[MyaCCt]

Hi all,

Kind of a newbie here... hoping to get some info on how to write code in order to have the report that I'm having generated in Access, exported to Excel through a module, have colors based on what is in the cell (specifically date information.)
For the first column to have the color grey across the top bar, I have used: xlSheet.Range("A1", "V1").Interior.ColorIndex = numCOLOR_Grey
Now what I want to do is if a date appears that is in the past, to have that colored red. If it's coming up in the next 30 days, I want that colored yellow. The sticky bit is though, that the date field is a text field and some have letters after the date. Example: the date could either look like 3/14/2014 or 3/14/2014 (p).

Am I making any sense at all? Please let me know if you need more information in order to assist.

Thank you!
-MCC

 

[Andrzejek]

Do you have Excel launched from your Access app?
Are you successful in making the A1:V1 row gray?
In what column do you have the dates?
“if a date appears that is in the past, to have that colored red” do you want the text of the cell to be red or a back color of the cell to be red?
If you have a date with a letter, do you always have a space between the two?
Do you have any empty rows without the dates?


Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[SkipVought]

Hi,

Why is your date field TEXT?

Why are there other characters in the date field?

Here's what may be happening in Excel. The TEXT, value 3/14/2014 may be converted by Excel to a date. The 3/14/2014 (p) remains as TEXT. You can use the Data > Text to Columns -- DELIMITED on SPACE, to discard (do not import) the (p) "column" AND selecting MDY for the date "column" in a post export process.

Furthermore, once that's done, I'd use the Conditional Formatting feature to shade your date cells.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[MyaCCt]

Yes, Excel is launched from Access.
Yes, I am successful making the top row gray.
The dates are in columns L1 through V219.
I would like it if the cell could be highlighted red/yellow.
Yes, there is always a space if there is a letter.
Yes, there are null fields.

Thanks!
-MCC

 

[Andrzejek]

Wherever possible, I would use Conditional Formatting feature like Skip suggested, but in your case you just need to highlight whole bunch of cells based on the value of the cell.

Try something like this:

Sub MakeCellsRedBlueYellow()
Dim r As Integer
Dim c As Integer
Dim strDate As String

For r = 1 To 219
    For c = 12 To 22    [green]'L to V[/green]
        If Cells(r, c).Value <> "" Then
            strDate = Split(Cells(r, c).Value, " ")(0)
            If IsDate(strDate) Then
                Select Case CDate(strDate)
                    Case Is < Date
                        Cells(r, c).Interior.Color = vbRed
                    Case Is < Date + 30
                        Cells(r, c).Interior.Color = vbBlue
                    Case Is > Date + 30
                        Cells(r, c).Interior.Color = vbYellow
                End Select
            End If
        End If
    Next c
Next r

End Sub

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[Andrzejek]

For this code to work from your Access app, you probably will need to add [tt][blue]xlSheet.[/blue]Cells(r, c)...[/tt]

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[MyaCCt]

Oh, maybe that's what I'm missing! I so thought this was really, really going to work!
What now? (what do you mean by the ...)

Thank you!!!

 

[Andrzejek]

Sub MakeCellsRedBlueYellow()
Dim r As Integer
Dim c As Integer
Dim strDate As String

For r = 1 To 219
    For c = 12 To 22    [green]'L to V[/green]
        If [blue]xlSheet.[/blue]Cells(r, c).Value <> "" Then
            strDate = Split([blue]xlSheet.[/blue]Cells(r, c).Value, " ")(0)
            If IsDate(strDate) Then
                Select Case CDate(strDate)
                    Case Is < Date
                        [blue]xlSheet.[/blue]Cells(r, c).Interior.Color = vbRed
                    Case Is < Date + 30
                        [blue]xlSheet.[/blue]Cells(r, c).Interior.Color = vbBlue
                    Case Is > Date + 30
                        [blue]xlSheet.[/blue]Cells(r, c).Interior.Color = vbYellow
                End Select
            End If
        End If
    Next c
Next r

End Sub

Does my code work for you OK?

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[MyaCCt]

Oh yes! We are definitely on the right path! The colors that I put in are obviously incorrect though. How do I tell it what color number I want? Right now I have it looking like:

Const numCOLOR_Red As Long = 38
Const numCOLOR_Grey As Long = 15
Const numCOLOR_Yellow As Long = 6
Const numCOLOR_Light_Green As Long = 35
Const numCOLOR_Light_Yellow As Long = 36
Const numCOLOR_Light_Blue As Long = 37
Const numCOLOR_Light_Orange As Long = 45
Const numCOLOR_Light_Purple As Long = 39
Const numCOLOR_Light_Pink As Long = 38

I think I want the red at least to be 255,0,0. Do I just put that in where the 38 is now?

Thank you so much!

 

[MyaCCt]

Oh wait, I did find the color names. Thank you very much!

So... scope of the report has changed (only a week on the job and i'm seeing a recurring trend)
Now they only want cells highlighted that have the letter next to the date, with the same parameters. How would I make it so that only the ones with the text after the date gets highlighted?

You are a lifesaver. Thank you so much!

-MCC

 

[Andrzejek]

I don't know what code you have right now, so I will work with my code:

Sub MakeCellsRedBlueYellow()
Dim r As Integer
Dim c As Integer
Dim strDate As String[blue]
Dim ary() As String[/blue]

For r = 1 To 219
    For c = 12 To 22    'L to V
        If xlSheet.Cells(r, c).Value <> "" Then
            strDate = Split(xlSheet.Cells(r, c).Value, " ")(0)[blue]
            ary = Split(xlSheet.Cells(r, c).Value, " ")
            If UBound(ary) > 0 Then[/blue]
                If IsDate(strDate) Then
                    Select Case CDate(strDate)
                        Case Is < Date
                            xlSheet.Cells(r, c).Interior.Color = vbRed
                        Case Is < Date + 30
                            xlSheet.Cells(r, c).Interior.Color = vbBlue
                        Case Is > Date + 30
                            xlSheet.Cells(r, c).Interior.Color = vbYellow
                    End Select
                End If
            [blue]End If[/blue]
        End If
    Next c
Next r

End Sub

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[MyaCCt]

Hmmmmm... that's a new one. "Error 9: Subscript out of range." So there are what... too many loops?

Private Sub q_WRTAll()
Set xlSheet = xlWorkbook.Sheets(1)
xlSheet.Activate
xlSheet.Name = "All Planners"

'OPEN recordset
varSQL = "SELECT * FROM q_WRTAll"
Set rst = CurrentDb.OpenRecordset(varSQL, dbOpenSnapshot, dbReadOnly, dbReadOnly)

'EDITS
' numCount = rst.RecordCount
' Call S2900_Edit_Row_Count
' If blnModuleError = True Then
' xlSheet.Range("A1").Value = "No current tool status available"
' GoTo EXIT_q_WRTAll
' End If

'GET Data
xlSheet.Range("A2").CopyFromRecordset rst

'COPY Column names from recordset
For iCol = 1 To rst.Fields.Count
xlSheet.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
Next
xlSheet.Cells.EntireColumn.AutoFit
xlSheet.Range("A1", "V1").Interior.ColorIndex = numCOLOR_Grey

For r = 1 To 219
For c = 12 To 22 'L to V
If xlSheet.Cells(r, c).Value <> "" Then
strDate = Split(xlSheet.Cells(r, c).Value, " ")(0)
ary = Split(xlSheet.Cells(r, c).Value, " ")
If UBound(ary) > 0 Then
If IsDate(strDate) Then
Select Case CDate(strDate)
Case Is < Date
xlSheet.Cells(r, c).Interior.Color = numCOLOR_Red
Case Is < Date + 30
xlSheet.Cells(r, c).Interior.Color = numCOLOR_Light_Blue
Case Is > Date + 30
xlSheet.Cells(r, c).Interior.Color = numCOLOR_Yellow
End Select
End If
End If
End If
Next c
Next r

EXIT_q_WRTAll:
On Error Resume Next
rst.Close
Set rst = Nothing
End Sub

 

[SkipVought]

Error 9: Subscript out of range"

On what statement?

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Andrzejek]

The dates are in columns L1 through V219" I see this is not true since you put field names in row 1 and data starts in A2

So change: [tt]For r = [red]2[/red] To 219[/tt]

No need to evauate the column names...

And yes, it would be nice to know which line of code causes "Error 9: Subscript out of range."

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[MyaCCt]

Gee whiz... I'd rather take a beating than have to walk through that code again! (though I did get some great insight on some legacy code pieces in the process! Hooray for learning!) It didnt like the color number I was using for grey. I set it back to 15 and all was right with the world. Thank you!!! This is really starting to take shape well!
Now how would I get it so that if there is a blank or contains ", ," in column A through K, I'd like it highlighted another color? How do I tell it to put a thin border around all the cells?
You should be knighted. Thank you for all your help!
-MCC

 

[Andrzejek]

Most of your questions could be answered by creating a simple macro in Excel and by looking at the code created for you in Excel by almighty Microsoft. Do you know how to do it?

Also, do you know how to step thru your code line by line to see what happens (to your Excel file) when every line of code is executed?

Please take it the right way. I would rather show/teach you how to fish.


Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[MyaCCt]

Well, there's a first time for everything. Thanks, I'll look at the macros.
Yes, I do know how to step through. Thanks!

Well, that's a handy little thing. Only it doesnt work. I did something wrong.

Sub HighlightNullDesignerOrange()
'
' HighlightNullDesignerOrange Macro
' OrangeInHRowIfNull
'

Range("H2:H220").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=LEN(TRIM(H2))=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

End Sub

Bummer. I'll keep plugging away. Thanks!

 

[Andrzejek]

In the code I gave you

Dim r As Integer  [green]'r is Row[/green]
Dim c As Integer  [green]'c is Column[/green]

For r = 1 To 219
    For c = 12 To 22    [green]'L to V
        'Loop thru all cells in Row 1 to 219
        ' and thru all cells in Columns 12 to 22[/green]
    Next c
Next r

You can modify this code to loop thru A to K columns

For r = 1 To 219
    For c = 1 To 21    [green]'A to K
        'Evaluate every Value of every cell here[/green]
    Next c
Next r

So if [tt]xlSheet.Cells(r, c).Value = ""[/tt] (blank) or [tt]xlSheet.Cells(r, c).Value = ", ,"[/tt] do something

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[SkipVought]

For r = 1 To 219
    For c = xlSheet.cells(1,"A").column to xlSheet.cells(1,"K").column    'A to K
        'Evaluate every Value of every cell here
    Next c
Next r

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[MyaCCt]

So maybe something like this:


For r = 1 To 220
For c = 1 To 11 'A to K
If xlSheet.Cells(r, c).Value = "" Then xlSheet.Cells(r, c).Interior.ColorIndex = numCOLOR_Light_Orange
Next c
Next r

For r = 1 To 220
For c = 1 To 11 'A to K
If xlSheet.Cells(r, c).Value = ", ," Then xlSheet.Cells(r, c).Interior.ColorIndex = numCOLOR_Light_Orange
Next c
Next r

might work?