VBA - holidays fill

mlcalves

New Member
Joined
Mar 10, 2021
Messages
47
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
Hi people,

I Have a file of holidays of workers, that should update the days of holidays of each worker on sheet afixar that has a holidays map.

My problem is that system doesn't fill the last day of the month, or days that ends on the last day of the month.

For example bruce has holidays of 27 to 31, system doesn't fill anything, but if is 27 to 30 (that 30 is not the last day of this month), system will fill 27 to 30. And for example if only have holidays, the system downs fill the day 31 on the map.


Can anyone help me? please


here is the file

Here is the code:

VBA Code:
'Corre procedimentos antes de salvar
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Questiona se pretende atualizar dados
Select Case MsgBox("Update holidays?", vbYesNo, "Férias")
    Case vbYes 'Caso selecionem sim, executa
    'Definição das variáveis
    Dim cell As Range
    Dim start
    Dim final
    Dim n
    Dim check As Boolean
    Dim counter
    
    n = "" 'define n igual a vazio
    check = False 'define check igual a falso
    k = ThisWorkbook.Sheets("Jan").Range("D8").End(xlDown).Row 'Define k igual à última linha preenchida na coluna D (nome ACC) na sheet Jan
    ThisWorkbook.Sheets("Jan").Select 'Seleciona sheet de janeiro
    ThisWorkbook.Sheets("Jan").Range("D8:d" & k).Select 'Seleciona desde na coluna D, desde a linha 8 até última linha preenchida
        
    counter = 2 'Define counter igual a 2
    
    For Each cell In Selection 'Por cada célula preenchida na coluna D a partir da linha 8, executa
        counter = counter + 1 'Soma mais 1 ao counter
        For s = 1 To 12 'Ciclo for com s igual 1 a 12 (refere-se a todos meses - Sheet's Jan a Dez)
        
            lrow = Sheets(s).Range("F7").End(xlToRight).Column - 1 'Encontra último dia de cada mês em cada sheet (jan a Dez)
            
            For i = 5 To lrow 'Ciclo for com i igual a 5 até último dia (coluna) de cada mês em cada sheet (jan a Dez)
            
                If Sheets(s).Cells(cell.Row, i).Text <> "" Then 'se cada linha a partir da coluna E (1º até último dia do mês) for diferente de vazio, executa
                    
                    If check = False Then 'Se a variável check é falsa, executa
                        start = Sheets(s).Cells(7, i).Text 'Define start igual à linha 7 da coluna E(1ºdia) até ao último dia do mÊs
                        Debug.Print start 'Inicia debug, permitindo verificar os dados que passam nesta variável a partir da Immediate Windows ->
                                          'Carregar em Ctrl + G para abrir a mesma.
                    Else
                    
                    End If
                
                    If Sheets(s).Cells(cell.Row, i + 1).Text <> "" Then 'se cada linha a partir da coluna E (1º até último dia do mês) for diferente de vazio, executa
                        check = True 'Define check igual a True
                    Else 'Caso contrário (não tenha dados), executa
                        final = Sheets(s).Cells(7, i).Text 'define final igual ao texto de cada coluna (dias)
                        
                        'Condição para validar se a variável start tem o mesmo valor da variável start ou para verificar se i- 1 seja a coluna total, executa
                        If start = final Or Cells(7, i - 1).Text = "Total" Then 'Valida se start é igual a final ou se i-1 contém o texto Total
                            n = n & Sheets(s).Cells(7, i).Text & "; " 'Define n igual ao dia da coluna
                        Else ' Caso contrário
                            n = n & start & " a " & final & "; " 'Define n igual start e a final, ou seja inicio e fim de férias do respetivo período
                        End If
                    End If
                    
                    final = "" 'Define final igual a nada
                Else 'Caso contrário
                    check = False 'Define a false igual a false
                End If
            Next
            
            Sheets("Afixar").Cells(cell.Row, s + 1 + s).Value = n 'Define linha selecionada na Sheet afixar igual ao valor de n
            
            start = "" 'Define start igual a nada
            final = "" 'Define final igual a nada
            n = "" 'Define n igual a nada
            Debug.Print counter
        Next
    Next
End Select
End Sub


Thank you

Regards
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
A gentle reminder:

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: UtterAccess.com
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 
Upvote 0
A gentle reminder:

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: UtterAccess.com
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
Hi Rory,

First i posted here, yesterday at 04:01pm. But today after check that i didn't get any responde, i posted in that forum at 9h32 am. And i didn't know that i have do edit post here and insert the link.

Thank you.
 
Upvote 0

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top