Getting error 1004

[mukeshbaviskar]

Hi friends,
I'm getting error 1004 in the following code. Please suggest me the correction.

Column 't' contains the birthdates of persons. My data is in range 'b8:ae3000'. My requirement is:

If column 't' contains the today's date (current date) then the entire row range 'b:ae' should color green and as normal black on next day.

Option Explicit

Sub color()
Dim a
Dim i As Variant

                                If Range("T").Value = Date Then
                                    Range("T").Select
                                    a = ActiveCell.Row
                                    Range("B" & a, "AE" & a).Select
                                        With Selection.Interior
                                            .color = vbGreen
                                        End With
                                End If
End Sub

Please suggest me a solution.

Thanking you in anticipation.

Regards,

Mukesh

[venkatpvc]

you have specify row number ex: T1, T2, T3

If Range("T1").Value = Date Then
Range("T1").Select

if you wanted to loop through entire T column use this below code

Sub color()
Dim a
Dim i As Variant
Dim lRow As Long
Dim myCel As Range
lRow = Cells(Rows.Count, "T").End(xlUp).Row
For Each myCel In Range("T1:T" & lRow)
    If myCel.Value = Date Then
        a = myCel.Row
        With Range("B" & a, "AE" & a).Interior
            .color = vbGreen
        End With
    End If
Next myCel
End Sub

[mukeshbaviskar]

Sorry for incomplete information. The column 't' contains the birthdates of persons. On the birthday of the person the entire row should color green. No matter what's the year is. For example: If the cell 't10' contains the date 22/02/1999 then the entire row range 'b10:ae10' should color green.

Please see the attachment.

Thank you.

Mukesh

[HaHoBe]

Hi, Mukesh,

maybe try it like this:

Sub ColorBirthdays()
Dim myCel As Range

Range("A1:AE" & Rows.Count).Interior.color = xlNone     'clear any color

For Each myCel In Range("T1:T" & Range("T" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants, 23)
  With myCel
    If Date = DateSerial(Year(Date), Month(.Value), Day(.Value)) Then
      Range("B" & .Row, "AE" & .Row).Interior.color = vbGreen
    End If
  End With
Next myCel

MsgBox "Done!", 64

End Sub

Ciao,
Holger

[mukeshbaviskar]

Hi venkatpvc,
Thank you for your cooperation to solve my problem. The code is working fine but the color is not changing after changing the date in column 't'. Ok! doesn't matter. The code suggested by Holger is giving the required output. Please don't mind. I appreciate you for your kind cooperation and efforts to solve the problem. Thank you.

Mukesh

[mukeshbaviskar]

Hi Holger,
Excellent! It's working absolutely fine with a correct output as per my requirement.

Just for my knowledge, what does the number 23 means in the code.

I'm getting message 'you must spread some reputation before giving hahobe again'.

What is wrong? Sorry!

Thank you.

Regards,

Mukesh

[HaHoBe]

Hi, Mukesh,

SpecialCells(xlCellTypeConstants) has 4 subtypes:

xlErrors      16  
xlLogical      4  
xlNumbers      1  
xlTextValues   2

If you add them up (which means allow any type of Constant values in the cells) you get the "mysterious" number of 23. As there must be Dates in the cells and these Dates are real dates, not mumeric text, i could have used 1 instead. But I wanted to include every possibilty so I choose the more comprehensive number of 23.


You need to spent reputation on somebody else before you are able to spend again on the same person. In ExcelForum it´s only 1 other person you need to "donate" to with this being laid down in the Admin Settings of vBulletin.

HTH,
Holger

[venkatpvc]

Sub color()
Dim a
Dim i As Variant
Dim lRow As Long
Dim myDate As Date
Dim myCel As Range
lRow = Cells(Rows.Count, "T").End(xlUp).Row
For Each myCel In Range("T1:T" & lRow)
    If Len(myCel) > 0 Then
        myDate = Month(Date) & "/" & Day(Date) & "/" & Right(myCel.Value, 4)
        If myCel.Value = myDate Then
            a = myCel.Row
            With Range("B" & a, "AE" & a).Interior
                .color = vbGreen
            End With
        End If
    End If
Next myCel
MsgBox "Done!", 64
End Sub

[mukeshbaviskar]

Hi Holger,
Good morning!

Thank you for explanation to improve my knowledge of vba.

Now I have one idea in my mind that is if we compare the current date in cell 'b4' which comes automatically after running the code daily.

The code in this workbook, workbook_open is:

With Sheets("Access").Range("b4")
        If .Value < Date Then
Call Anniversary
                                           .Value = Date
                                                                               End If
            End With

If we compare the dates in column 't' with cell 'b4' day and month then we need not to run this macro daily. At present if I update any date in column 't' then I have to run the macro to update it.

Suggestion is:

If the day and month in cell 'b4' is = to the day and month in column 't' then it should color green. B4 = current date

If it is possible then do it otherwise leave it. I will put this code in this workbook code to run it automatically using call event. I don't want to change the output of the code but only want to link up it with the current date in cell 'b4' to do it automatically.

Thank you and have a nice day.

Regards,

Mukesh

[HaHoBe]

Hi, Mukesh,

what do you really want to achieve? Me to rewrite every bit of code that you have gathered from the Forum so far?

You mentioned the given cell but that cell will hold the date after the code is run. So it might be possible to adapt the original macro to your needs but I doubt this should be part of me participating or be part of this thread.

Ciao,
Holger

[mukeshbaviskar]

Hi Holger,
Sorry! I asked you to whether it's possible or not. Don't mind. I don't want you to rewrite each and every code. I want to learn coding from you and the forum friends.

I have inserted the macro in this workbook call event and it's running without error. The output is as per expectation.

I don't want to trouble you more. Now my problem is solved.

I once again appreciate you for solving my problem.

Thank you and have a nice day!

Regards,

Mukesh

[mukeshbaviskar]

Hi Holger,
Good morning!

Sorry! Today I'm facing a problem in the code 'run-time error 13 time mismatch' on the following line.

Option Explicit

Sub ColorBirthdays()
Dim myCel As Range

Range("A1:AE" & Rows.Count).Interior.Color = xlNone     'clear any color

For Each myCel In Range("T1:T" & Range("T" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants, 23)
  With myCel
    If Date = DateSerial(Year(Date), month(.Value), Day(.Value)) Then
      Range("B" & .Row, "AE" & .Row).Interior.Color = vbGreen
    End If
  End With
Next myCel

MsgBox "Done!", 64

End Sub

The error is in the line:

    If Date = DateSerial(Year(Date), month(.Value), Day(.Value)) Then

Sorry for trouble again.

Thank you.

(The problem is related to this thread so I posted it here though the thread is solved and didn't start a new thread. Sorry for it.)

Regards,

Mukesh

[HaHoBe]

Hi, Mukesh,

Sub ColorBirthdays()
Dim myCel As Range

Range("A1:AE" & Rows.Count).Interior.color = xlNone     'clear any color

For Each myCel In Range("T1:T" & Range("T" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants, 23)
  With myCel
    If IsNumeric(.Value) Then
      If Date = DateSerial(Year(Date), Month(.Value), Day(.Value)) Then
        Range("B" & .Row, "AE" & .Row).Interior.color = vbGreen
      End If
    End If
  End With
Next myCel

MsgBox "Done!", 64

End Sub

Without your workbook I would expect one or more cells not to be dates (maybe a header).

Ciao,
Holger

[mukeshbaviskar]

Hello Holger,
Thank you. Now the error is gone but no output. I'm attaching the workbook for your reference.

Thank you.

Regards,

Mukesh

[HaHoBe]

Hi, Mukesh,

Sub ColorBirthdays()
Dim myCel As Range

Range("A8:AE" & Rows.Count).Interior.Color = xlNone     'clear any color

For Each myCel In Range("T8:T" & Range("T" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants, 23)
  With myCel
    If IsDate(.Value) Then
      If Date = DateSerial(Year(Date), Month(.Value), Day(.Value)) Then
        Range("B" & .Row, "AE" & .Row).Interior.Color = vbGreen
      End If
    End If
  End With
Next myCel

MsgBox "Done!", 64

End Sub

Ciao,
Holger

[mukeshbaviskar]

Hi Holger,
Excellent! Now it's working fine.

Problem solved.

Thank you and have a nice day!

Regards,

Mukesh