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:
Thank you
Regards
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