VBA range("single cell selected based on employee name and start time of shift").value = 1

[life_in_picture_format]

I feel like I may be overthinking this but after hours and hours of testing different codes I am bringing it to y'all for some help.

What code can I use to select lets say Fake Guy 3 and have him start work at 5:45 AM. I want to select and enter a 1 in cell G16 in that instance

daily wrk Schedule 5 min increments NEWMR EXCEL.xlsm
	D	E	F	G	H	I	J
5	24 hour Time	FAKE GUY 1	FAKE GUY 2	FAKE GUY 3	FAKE GUY 4	FAKE GUY 5	FAKE GUY 6
6
7	5:00 AM
8	5:05 AM
9	5:10 AM
10	5:15 AM
11	5:20 AM
12	5:25 AM
13	5:30 AM
14	5:35 AM
15	5:40 AM
16	5:45 AM
17	5:50 AM
18	5:55 AM
Schedule

sorry not sure why my table posted all crunched up like that:

I want this to be triggered by selecting the start time from a drop down menu on a separate sheet and I want it to be able to adjust based upon the selection made in te drop down menu.

daily wrk Schedule 5 min increments NEWMR EXCEL.xlsm
	B	C
5	Name	start
6	FAKE GUY 1
7	FAKE GUY 2
8	FAKE GUY 3	5:45 AM
9	FAKE GUY 4
10	FAKE GUY 5
11	FAKE GUY 6
12	FAKE GUY 7
13	FAKE GUY 8
Sheet1

Cells with Data Validation
Cell	Allow	Criteria
C6:C13	List	=MondayShift

Thank you in advance

 

[petertenthije]

Sub Macro1()
   
   
' i starts as the first name on your data entry list. As the loop
' progresses it will look for the second, third, fourth... names.
'
' The loop will continue for as long as you have names in range B6:B~
' of Sheet1. The macro will stop as soon as an empty cell is reached,
' even if there are more rows with data below!
'
' This macro removes existing data for the people that are replanned,
' but it does not remove the data from people without a new plan!


' Determine the last row and column with data on worksheet Schedule.
Sheets("Schedule").Select
With ActiveSheet
    LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
    lastcolumn = .Cells(5, Columns.Count).End(xlToLeft).Column
End With


i = 6
Do While Len(Sheets("Sheet1").Range("B" & i)) > 0

    Employee = Sheets("Sheet1").Range("B" & i)
    Starttime = Sheets("Sheet1").Range("C" & i)

    If Len(Starttime) > 0 Then
        ' Identify the desired column number in the specified range on worksheet SCHEDULE
            WsSchedule_Column = WorksheetFunction.Match(Employee, Sheets("Schedule").Range(Cells(5, 5), Cells(5, lastcolumn)), 0)
   
        ' Identify the desired row number in the specified range on worksheet SCHEDULE
            WsSchedule_Row = WorksheetFunction.Match(Starttime, Range("Schedule!D6:D" & LastRow), 0)
       
        ' Remove existing planning
            Range(Cells(6, WsSchedule_Column + 4), Cells(LastRow, WsSchedule_Column + 4)).ClearContents

        ' Add a "1" in the desired cell.
            Sheets("Schedule").Range("D5").Offset(WsSchedule_Row, WsSchedule_Column).FormulaR1C1 = 1
    End If

i = i + 1
Loop



End Sub

 

[life_in_picture_format]

I have an amateur question for you. I keep getting this compule error when it hits Lastrow

Sub Macro1()
 
 
' i starts as the first name on your data entry list. As the loop
' progresses it will look for the second, third, fourth... names.
'
' The loop will continue for as long as you have names in range B6:B~
' of Sheet1. The macro will stop as soon as an empty cell is reached,
' even if there are more rows with data below!
'
' This macro removes existing data for the people that are replanned,
' but it does not remove the data from people without a new plan!


' Determine the last row and column with data on worksheet Schedule.
Sheets("Schedule").Select
With ActiveSheet
    LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
    lastcolumn = .Cells(5, Columns.Count).End(xlToLeft).Column
End With


i = 6
Do While Len(Sheets("Sheet1").Range("B" & i)) > 0

    Employee = Sheets("Sheet1").Range("B" & i)
    Starttime = Sheets("Sheet1").Range("C" & i)

    If Len(Starttime) > 0 Then
        ' Identify the desired column number in the specified range on worksheet SCHEDULE
            WsSchedule_Column = WorksheetFunction.Match(Employee, Sheets("Schedule").Range(Cells(5, 5), Cells(5, lastcolumn)), 0)
 
        ' Identify the desired row number in the specified range on worksheet SCHEDULE
            WsSchedule_Row = WorksheetFunction.Match(Starttime, Range("Schedule!D6:D" & LastRow), 0)
     
        ' Remove existing planning
            Range(Cells(6, WsSchedule_Column + 4), Cells(LastRow, WsSchedule_Column + 4)).ClearContents

        ' Add a "1" in the desired cell.
            Sheets("Schedule").Range("D5").Offset(WsSchedule_Row, WsSchedule_Column).FormulaR1C1 = 1
    End If

i = i + 1
Loop



End Sub

Sub Macro1()
  
  
' i starts as the first name on your data entry list. As the loop
' progresses it will look for the second, third, fourth... names.
'
' The loop will continue for as long as you have names in range B6:B~
' of Sheet1. The macro will stop as soon as an empty cell is reached,
' even if there are more rows with data below!
'
' This macro removes existing data for the people that are replanned,
' but it does not remove the data from people without a new plan!


' Determine the last row and column with data on worksheet Schedule.
Sheets("Schedule").Select
With ActiveSheet
    LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
    lastcolumn = .Cells(5, Columns.Count).End(xlToLeft).Column
End With


i = 6
Do While Len(Sheets("Sheet1").Range("B" & i)) > 0

    Employee = Sheets("Sheet1").Range("B" & i)
    Starttime = Sheets("Sheet1").Range("C" & i)

    If Len(Starttime) > 0 Then
        ' Identify the desired column number in the specified range on worksheet SCHEDULE
            WsSchedule_Column = WorksheetFunction.Match(Employee, Sheets("Schedule").Range(Cells(5, 5), Cells(5, lastcolumn)), 0)
  
        ' Identify the desired row number in the specified range on worksheet SCHEDULE
            WsSchedule_Row = WorksheetFunction.Match(Starttime, Range("Schedule!D6:D" & LastRow), 0)
      
        ' Remove existing planning
            Range(Cells(6, WsSchedule_Column + 4), Cells(LastRow, WsSchedule_Column + 4)).ClearContents

        ' Add a "1" in the desired cell.
            Sheets("Schedule").Range("D5").Offset(WsSchedule_Row, WsSchedule_Column).FormulaR1C1 = 1
    End If

i = i + 1
Loop



End Sub

I keep getting this error when I run the code. Sorry I am still an amateur in some areas with VBA

r

 

[petertenthije]

Strange, it does work for me.

Are the worksheets still called Schedule and Sheet1?

You could try adding this at the beginning of the macro:

Dim LastRow As Integer
Dim lastcolumn As Integer

 

[life_in_picture_format]

YEP that did it! One more thing @petertenthije ...lets say I want to add the 1 to that cell then I want VBA to copy a 1 for the next 108 cells (if they ae fulltime) would you recommend I use a XLFillValues code for that?

Strange, it does work for me.

Are the worksheets still called Schedule and Sheet1?

You could try adding this at the beginning of the macro:

Dim LastRow As Integer
Dim lastcolumn As Integer

 

[petertenthije]

lets say I want to add the 1 to that cell then I want VBA to copy a 1 for the next 108 cells

Replace:
Sheets("Schedule").Range("D5").Offset(WsSchedule_Row, WsSchedule_Column).FormulaR1C1 = 1


With:
Sheets("Schedule").Range("D5").Offset(WsSchedule_Row, WsSchedule_Column).Select
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(108, 0)).FormulaR1C1 = 1

 

[life_in_picture_format]

Replace:
Sheets("Schedule").Range("D5").Offset(WsSchedule_Row, WsSchedule_Column).FormulaR1C1 = 1


With:
Sheets("Schedule").Range("D5").Offset(WsSchedule_Row, WsSchedule_Column).Select
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(108, 0)).FormulaR1C1 = 1

You are amazing!