Asigne un valor de un rango vertical en orden ascendente a otra celda la primera vez que se cumpla un criterio y luego salga

Question

No estoy seguro de estar haciendo esto correctamente, pero estoy intentando escribir una subrutina que busque el primer valor que cumpla con mis criterios, luego lo copie en otra celda y luego deje de buscar más valores.

Para ser explícito, tengo una columna de 18 meses en orden ascendente (del más antiguo al más nuevo) y la estoy comparando con la fecha de hoy.

• 01 de septiembre de 2019
• 1 de octubre de 2019
• 1 de noviembre de 2019
• 1 de diciembre de 2019
• 1 de enero de 2020
• 1 de febrero de 2020
• 1 de marzo de 2020
• 01 de abril de 2020
• 1 de mayo de 2020
• 1 de junio de 2020
• 1 de julio de 2020
• 1 de agosto de 2020
• 01 de septiembre de 2020
• 1 de octubre de 2020
• 1 de noviembre de 2020
• 1 de diciembre de 2020
• 1 de enero de 2021
• 1 de febrero de 2021

Luego quiero que el primer mes posterior a la fecha de hoy se copie en otra celda y luego que la macro deje de buscar más valores que cumplan con este criterio.

Así es como se ve mi código ahora mismo.

Sub Show_remaining_months()

        Dim TodaysDate As Long 'Today's Value
        
        Dim MonthCell As Range
        Dim i As Byte
        Dim EndHere As Byte
        
        
        Dim RestoreRefStyle As Integer
        Let RestoreRefStyle = Application.ReferenceStyle
        
        
        Application.ReferenceStyle = xlR1C1
        
        
        ThisWorkbook.Worksheets("subtotalizer(r-hrs)").Activate
        
        Let TodaysDate = Worksheets("subtotalizer(r-hrs)").Range("R1C5").Value ' TodaysDate = 44012
        
        
                    
                    
                    
                Let EndHere = 23
                                                     'Range(R6C3:R23C3)
                                For Each MonthCell In Range("R6C3:R" & (EndHere) & C3)
                                        
                                        For i = 6 To EndHere ' For i = 6 To 23
                                                             ' Which later then becomes i To EndHere.
                                                                                                                                                                             
                                                   If MonthCell.Value < TodaysDate Then
                                                   'Skip
                                                   i = i + 1
                                                   'i = 6 + 1 = 7
                                                   
                                                   Else
                                                   Let Range(R3C5).Value = MonthCell.Value
                                                   'i = i + 1
                                                   EndHere = i
                                                   
                                                   End If
                                                                                                 
                                       Next i
                                
                                Next MonthCell
 
    
        Application.ReferenceStyle = RestoreRefStyle


End Sub

Recibo el código de error 1004: error definido por la aplicación o definido por el objeto

Para ser honesto, creo que estoy pensando demasiado en esto. Soy nuevo en la programación VBA.

Answer 1

Esta reescritura hace exactamente lo que quería. Lo estaba pensando demasiado.

Sub Show_remaining_months()


    Dim TodaysDate As Long 'Today's Value
    Dim StartDate As Range
            
    Dim MonthCell As Range
    Dim i As Byte
    Dim EndHere As Byte
        

        ThisWorkbook.Worksheets("subtotalizer(r-hrs)").Activate
        
        Let TodaysDate = Range("E1").Value
        Set CurrentStartDate = Range("E3")
        

              For Each MonthCell In Range("C6:C23")
                                        
                         If MonthCell.Value > TodaysDate Then
                            CurrentStartDate.Value = MonthCell.Value
                                    
                            Exit Sub
                                                 
                         End If
            
              Next MonthCell
 
End Sub