Conditional Criteria with colored cells

[fher9728]

Hi community,

I've been doing some work in a table, and this table works a lot with dates, so the thing I wanted to do is that dates that are 15 days after todays date they'll be highlight in color yellow, I did that with no problems with conditional formatting, but the problem that I have is in the next step, I want that the cells that are highlight in yellow shows a Status that says "Vencida" and the cells that aren't highlight show status "Vigente", but I want to do this full with Vba, but without a vba function because I dont want to use formulas because the range of data is so extensive that the Workbook will be so big and I need to remain a fast and light workbook, I'll show the table:

The thing I want to do is like a conditional that if cells with range G are highlight with yellow color the status in range M shows me "Vencida" else show "Vigente",
I've been trying to do that but it only shows me Vigente, but the status doesn't change to Vencida, this is the code:

Sub COUNT_HIGHLIGHTS()
'
' COUNT_HIGHLIGHTS
'


'Defining variables
Dim LastRow As Long, Count As String
Dim celdaOrigen As Range, rango As Range


'Getting a number value for the number of rows in the table (as this can vary on table size)
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "G").End(xlUp).Row


'For loop to loop through rows
For i = 2 To LastRow
'Count is the number of cells in the row which are highlighted
Count = "VIGENTE"
'For loop for cells within the row (My table always has 36 cells)
For J = 2 To LastRow
'If statement to check if cell is highlighted
If Cells(i, 7).Interior.Color = ActiveSheet.Range("U1").Interior.Color Then
'Add +1 to count ever time a highlighted cell is found
Count = "VENCIDA"
End If
Next J
'find cell at the end of the row and add the count
Cells(i, 13).Select
Selection.Value = Count
Next i
End Sub

SECOND POINT

In column H,J,K,L I have an vba code which if I put any text or value in Column B range it will throw me automatically todays date, like registration date in the table, the problem that I have is that I need to copy paste data from another table and if do that it doesnt shows me automatically the registration date, I want to copy and paste the data un column B and automatically shows me the date in column G, also I want to let me undo the action because when I modify something in this two columns it doesn't let me undo any action:

the vba code for this is :

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Range("B:B")) Is Nothing Then

Range("H" & Target.Row) = Date

Range("I" & Target.Row) = Format(Now, "hh:mm")

End If

If Not Application.Intersect(Target, Range("J:J")) Is Nothing Then

Range("K" & Target.Row) = Date + Target.Value

End If

If Not Application.Intersect(Target, Range("K:K")) Is Nothing Then

Range("L" & Target.Row) = Target.Value

End If
End Sub

Pleaaase I need help, thankyou

 

[Fluff]

For part 1 how about

Sub fher()
   Dim Cl As Range
   
   For Each Cl In Range("G2", Range("G" & Rows.Count).End(xlUp))
      If Cl.DisplayFormat.Interior.Color = vbYellow Then
         Cl.Offset(, 6).Value = "VIGENTE"
      Else
         Cl.Offset(, 6).Value = "VENCIDA"
      End If
   Next Cl
End Sub

For part 2, whenever you change a workbook with a macro you lose the Undo ability.

 

[fher9728]

For part 1 how about

Sub fher()
   Dim Cl As Range
  
   For Each Cl In Range("G2", Range("G" & Rows.Count).End(xlUp))
      If Cl.DisplayFormat.Interior.Color = vbYellow Then
         Cl.Offset(, 6).Value = "VIGENTE"
      Else
         Cl.Offset(, 6).Value = "VENCIDA"
      End If
   Next Cl
End Sub

For part 2, whenever you change a workbook with a macro you lose the Undo ability.

hi, it works perfect thats exactky how I wanted to worked, thank you so much,

about part 2, I understand, but isn't there a way when I copy the data automatically shows me up the registration date instead of doing it manually, because the problem that I have is when i copy values in column B it doesnt shows me automatically the registration date

 

[Fluff]

Are you just pasting values into col B?

 

[fher9728]

Are you just pasting values into col B?

Exactly, only pasting values

 

[Fluff]

Yes, but is that only into column B?

 

[Fluff]

Cross posted https://chandoo.org/forum/threads/conditional-criteria-with-colored-cells.43911/

While we do allow Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

 

[fher9728]

Yes, but is that only into column B?

No, I paste data in Column B, C, D but it is enough that the registered date change when the data in column B is changed. can you please help me?

 

[fher9728]

Cross posted Conditional criteria with colored cells

While we do allow Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

Sorry, I didn't really knew that, from now and on I'll provide mention that i'm doing it and provide the link of the thread, my bad.

 

[Fluff]

Ok, how about

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Cl As Range
   If Not Application.Intersect(Target, Range("B:B")) Is Nothing Then
      For Each Cl In Intersect(Target, Range("B:B"))
         Cl.Offset(, 6) = Date
         Cl.Offset(, 7) = Format(Now, "hh:mm")
      Next Cl
   ElseIf Not Application.Intersect(Target, Range("J:J")) Is Nothing Then
      Range("K" & Target.Row) = Date + Target.Value
   ElseIf Not Application.Intersect(Target, Range("K:K")) Is Nothing Then
      Range("L" & Target.Row) = Target.Value
   End If
End Sub