Select one cell

lasher18

New Member
Joined
May 15, 2020
Messages
5
Office Version
  1. 2013
  2. 2011
Platform
  1. Windows
Hi all,
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
 

Some videos you may like

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
13,974
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
What do you man by allow users to select one cell if you mean if selecting more than one cell is not allowed then
VBA Code:
If Target.Column >= 2 And Target.Row >= 8 and  Target.Cells.Count  = 1 Then
If you mean something else then please elaborate.

By the way the syntax for selecting a cell normally is
VBA Code:
Cells(? , ? ).Select
or the first cell in a Selection is
VBA Code:
Selection.Cells(1).Select
 

lasher18

New Member
Joined
May 15, 2020
Messages
5
Office Version
  1. 2013
  2. 2011
Platform
  1. Windows
Hi,
what I mean is not to allow users to select more than one cell at the same time. But I do not know how to introduce it in the code with several worksheet_selectionchange in the code.
I have tried your solution but it is not working for me. What shoul I do?

Thanks
Capture1.PNG
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
13,974
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
They can select as many cells as they want with the code I posted but the code shouldn't run past that line if they have anything other than one cell selected at it should bypass the If statement.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,318
Messages
5,623,976
Members
416,003
Latest member
indyman

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
Top