Hi all,
Where should I introduce this piece of code to allow users to select just one cell at a time?
I'd need to introduce it here:
Where should I introduce this piece of code to allow users to select just one cell at a time?
VBA Code:
select.cells(1)I'd need to introduce it here:
Code:
Option Explicit
Public ValorAnterior As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim pepe As String
pepe = Target.Address
If Target.Column >= 2 And Target.Row >= 8 Then
ValorAnterior = Target.Value
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim HojaLog As Worksheet
Dim rangolog As Range
Dim NuevaFila As Integer
Dim ColCambio As Integer
Dim ColInicio As Integer
Dim ColFin As Integer
Dim MesAux As Integer
Dim AñoAux As Integer
Dim FechaInicio As Date
Dim FechaCambio As Date
Dim FechaLunes As Date
Dim FechaViernes As Date
Dim RangoCal_1 As Range
Dim Despl As Integer
Dim Caso As Integer
Dim Mensaje As String
'Si la celda modificada no está entre las filas 8 a 17 o 21 a 30, 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
'Si está en una columna no valida, salir
If LeaveTracker.Cells(5, Target.Column).Value = "" Then
Mensaje = "Please position yourself in a valid column."
MsgBox Mensaje, vbExclamation + vbOKOnly, "Error"
Exit Sub
End If
'Calcula fecha de inicio 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 de dato modificado
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))
If Weekday(FechaCambio, vbSunday) = 1 Or Weekday(FechaCambio, vbSunday) = 7 Then
Mensaje = "Please position yourself in a valid column." & vbCrLf
Mensaje = Mensaje & "You cannot choose weekends days."
MsgBox Mensaje, vbExclamation + vbOKOnly, "Error"
Exit Sub
End If
'Calcular desplazamiento causado por los huecos entre días de mes <31 a 1 mes siguiente. Necesario para compensar la resta de fechas
Despl = (LeaveTracker.Cells(3, 1) - 1) * 31 - (CLng(FechaCambio) - CLng(FechaInicio) - Day(FechaCambio)) - 1
'Determinar posicion (numero columna) que corresponde a la fecha modificada
ColCambio = FechaCambio - FechaInicio + Despl + 2
'Determinar fecha del lunes y viernes para la semana definida (No se usa desplazamiento porque se opera con fechas,
'no se busca columna en que está ubicada la fecha
FechaLunes = FechaCambio - Weekday(FechaCambio, vbSunday) + 2
FechaViernes = FechaLunes + 4
'*************** Determinar principio y fin de mes para no salirse del rango visto ***************************
'Si FechaLunes y FechaCambio son del mismo mes, no hay problema, es una semana "normal"
If Month(FechaLunes) = Month(FechaViernes) Then
'Columna seleccionada sera FechaLunes - FechaInicio
ColInicio = CInt(FechaLunes - FechaInicio) + 2 + Despl
ColFin = ColInicio + 4
Else
'Determinar el caso
Caso = 1000 * (Month(FechaLunes) = Month(FechaCambio)) _
+ 100 * (Month(FechaCambio) = Month(FechaViernes)) _
+ 10 * (Year(FechaLunes) = Year(FechaCambio)) _
+ (Year(FechaViernes) = Year(FechaCambio))
Select Case Caso
Case -1111 '-1111 -> Semana "normal"
ColInicio = ColCambio + CInt(FechaLunes - FechaInicio)
ColFin = ColInicio + 4
Case -111, -101 '-111 -> Ambos meses mismo año - Primera semana de mes visto
'-101 -> Mes lunes en año previo a calendario
ColInicio = ColCambio - CInt(FechaCambio - CDate("01/" & Month(FechaCambio) & "/" & Year(FechaCambio)))
ColFin = ColCambio + CInt(FechaViernes - FechaCambio)
Case -1011 '-1011 -> Ambos meses mismo año - Ultima semana de mes visto
ColInicio = ColCambio - CInt(FechaCambio - FechaLunes)
ColFin = ColCambio + CInt(CDate("01/" & Month(FechaCambio) + 1 & "/" & Year(FechaCambio)) - FechaCambio - 1)
Case -1010 '-1010 -> Mes viernes en año siguiente a calendario
ColInicio = ColCambio - CInt(FechaCambio - FechaLunes)
ColFin = ColCambio + CInt(CDate("01/01/" & Year(FechaCambio) + 1) - FechaCambio - 1)
'Case 10 'Mes lunes en año previo a calendario
'Case 100 'Mes viernes en año siguiente a calendario
End Select
End If
' 'Comporbacion
' Mensaje = "Fecha modificada: " & FechaCambio & vbCrLf _
' & "Fecha lunes: " & FechaLunes & vbCrLf _
' & "Fecha viernes:" & FechaViernes & vbCrLf _
' & "Col inicio: " & ColInicio & vbCrLf _
' & "Col fin: " & ColFin
'
' MsgBox Mensaje, vbOKOnly
' Exit Sub
Set RangoCal_1 = Union(LeaveTracker.Range(Cells(8, ColInicio), Cells(17, ColFin)), LeaveTracker.Range(Cells(21, ColInicio), Cells(30, ColFin)))
Call Colorear(ColInicio, ColFin)
If Target.Column >= 2 And Target.Row >= 8 Then
Set HojaLog = ThisWorkbook.Sheets("LogDetails")
Set rangolog = HojaLog.Range("A1").CurrentRegion
NuevaFila = rangolog.Rows.Count + 1
With HojaLog
.Cells(NuevaFila, 1).Value = Date
.Cells(NuevaFila, 2).Value = Time
.Cells(NuevaFila, 3).Value = Target.Address
.Cells(NuevaFila, 4).Value = ValorAnterior
.Cells(NuevaFila, 5).Value = Target.Value
.Cells(NuevaFila, 6).Value = Environ("Username")
.Cells(NuevaFila, 7).Value = Right(Target.Address, 2)
.Cells(NuevaFila, 8).Value = Mid(Target.Address, 2, 2)
.Cells(NuevaFila, 9).Value = "=VLOOKUP(RC[-2],userranges,2,FALSE)"
.Cells(NuevaFila, 10).Value = "=IF(RC[-1]=RC[-4],"""",""INCORRECT"")"
.Cells(NuevaFila, 11).Value = "=VLOOKUP(RC[-3],REF,2,FALSE)"
.Cells(NuevaFila, 12).Value = "=VLOOKUP(RC[-4],REF,3,FALSE)"
.Cells(NuevaFila, 13).Value = "=VLOOKUP(RC[-5],REF,4,FALSE)"
.Cells(NuevaFila, 14).Value = "=VLOOKUP(RC[-6],REF,5,FALSE)"
.Cells(NuevaFila, 15).Value = "=IF(RC[-10]=""v"",1,-1)"
.Cells(NuevaFila, 16).Value = "=VLOOKUP(RC[-8],REFF,6,FALSE)"
.Cells(NuevaFila, 17).Value = "=VLOOKUP(RC[-8],inf,3,FALSE)"
End With
End If
End Sub
