VBA range problem

[lasher18]

Hello everyone,

I have been doing a vacation tracker for my department, and got a macro that evaluates the assignment every week (Subranges).

The problem lies in those months with less than 31 days, such as June. See attached the screenshot.

What do I need to modify in the code to solve this so that the macro identifies the entire week range so that column is not left blank?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim HojaLog As Worksheet
    Dim rangolog As Range
    Dim NuevaFila As Integer
    Dim ColInicio As Integer
    Dim FechaInicio As Date
    Dim FechaCambio As Date
    Dim FechaLunes As Date
    Dim RangoCal_1 As Range
    Dim Despl As Integer

    'Si la celda modificada no está entre las filas 8 a 17, sale
    If (Not (Target.Row >= 8 And Target.Row <= 17) And Not (Target.Row >= 21 And Target.Row <= 30)) Or Target.Column > 373 Or Target.Column < 2 Then Exit Sub
    
    'Calcula fecha de incio del calendario en base a los datos de las celdas A1 y A2
    FechaInicio = CLng(CDate("01/" & LeaveTracker.Cells(1, 1).Value & "/" & LeaveTracker.Cells(2, 1).Value))
    
    'Construir fecha seleccinada
    FechaCambio = DateSerial(CInt(LeaveTracker.Cells(2, 1).Value), _
        CInt(LeaveTracker.Cells(1, 1).Value + LeaveTracker.Cells(3, 1).Value - 1), _
        CInt(LeaveTracker.Cells(5, Target.Column).Value))
    
    'Calcular desplazamiento del rango en base a meses de menos de 31 dias
    Despl = (LeaveTracker.Cells(3, 1) - 1) * 31 - (CLng(FechaCambio) - CLng(FechaInicio) - Day(FechaCambio)) - 1
    
    'Determinar columna del lunes para la semana definida
    FechaLunes = FechaCambio - Weekday(FechaCambio, vbSunday) + 2 '+ Despl
    
    'Columna seleccionada sera FechaLunes - FechaInicio
    ColInicio = CInt(FechaLunes - FechaInicio) + 2 + Despl
 
    Set RangoCal_1 = Union(LeaveTracker.Range(Cells(8, ColInicio), Cells(17, ColInicio + 4)), LeaveTracker.Range(Cells(21, ColInicio), Cells(30, ColInicio + 4)))
    
    Call Colorear(ColInicio)

 

[Rijnsent]

Hi there,
You could find the last day of your month, e.g.

LastDayOfMonth = Day(DateSerial(LeaveTracker.Cells(2, 1).Value), LeaveTracker.Cells(1, 1).Value + 1, 0))

And use that variable in your other code.
Hope that helps,
Koen

 

[lasher18]

Hi rijnsent, thanks for your reply,

Should I remove other lines of the code? Because I tried it but it removes the weekends
Where should I place it?

Thanks