Looking for some advice..

[cweggleto81]

Hi all,
I am making a spreadsheet for work which consists of several Cells containing text relating to job that have to be accomplished during a night's work. I have these all listed down the sheet from B4 down. I want to colour these depending on the time the job needs to be completed by which is not an issue. What I am looking to do is make 4 more columns with peoples names e.g. John, Bill, Peter and Bob and then be able to click and drag the cell with the job I want to allocate to them underneath there name and have it move out of the list of jobs and re position under there name. Basically dragging jobs to people from the list until it is empty. Is their a simple way to do this?

Kind Regards
Chris

 

[My Aswer Is This]

Assuming The jobs are list in column B
And worker names are in Range("C1:F1")

I suggest this.

This is a double click sheet event script.

Double click on a job in column B select the worker name from a list of choices
Presented in a Popup Inputbox.
The choices will be the names found in Range("C1:F1")
Enter the number 1 to 4 which ever is your choice

Click OK and presto that job is now assigned to the proper employee.


This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Modified  12/2/2019  5:43:18 PM  EST
If Target.Column = 2 And Target.Row > 3 Then
Cancel = True

On Error GoTo M
Dim Msg As String, OptNum As Variant, Sht As Worksheet
Dim Employee1 As String
Dim Employee2 As String
Dim Employee3 As String
Dim Employee4 As String
Employee1 = Cells(1, 3).Value
Employee2 = Cells(1, 4).Value
Employee3 = Cells(1, 5).Value
Employee4 = Cells(1, 6).Value



Msg = "Enter the option number from the Options below" & vbCrLf & vbCrLf
Msg = Msg & "1." & Employee1
Msg = Msg & vbCrLf & vbCrLf & "2." & Employee2
Msg = Msg & vbCrLf & vbCrLf & "3." & Employee3
Msg = Msg & vbCrLf & vbCrLf & "4." & Employee4

OptNum = Application.InputBox(Msg, Title:="Select a workers name", Type:=1)
If OptNum = False Then Exit Sub

Select Case OptNum
    Case 1
        Target.Offset(, 1).Value = Target.Value: Target.Value = ""
    Case 2
        Target.Offset(, 2).Value = Target.Value: Target.Value = ""
    Case 3
        Target.Offset(, 3).Value = Target.Value: Target.Value = ""
    Case 4
        Target.Offset(, 4).Value = Target.Value: Target.Value = ""
End Select
End If
Exit Sub
M:

MsgBox "You failed to enter a Option"



End Sub

 

[Logit]

After clicking on the cell in Col B, the user may click and hold the bold border around that cell and drag it to the worker's column who will be assigned the job.

More than one cell can be selected at one time and the group of cells dragged to the new location.

Unless I am misunderstanding what you are requesting, there should not be a need for code at all.

?????

 

[cweggleto81]

Assuming The jobs are list in column B
And worker names are in Range("C1:F1")

I suggest this.

This is a double click sheet event script.

Double click on a job in column B select the worker name from a list of choices
Presented in a Popup Inputbox.
The choices will be the names found in Range("C1:F1")
Enter the number 1 to 4 which ever is your choice

Click OK and presto that job is now assigned to the proper employee.


This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Modified  12/2/2019  5:43:18 PM  EST
If Target.Column = 2 And Target.Row > 3 Then
Cancel = True

On Error GoTo M
Dim Msg As String, OptNum As Variant, Sht As Worksheet
Dim Employee1 As String
Dim Employee2 As String
Dim Employee3 As String
Dim Employee4 As String
Employee1 = Cells(1, 3).Value
Employee2 = Cells(1, 4).Value
Employee3 = Cells(1, 5).Value
Employee4 = Cells(1, 6).Value



Msg = "Enter the option number from the Options below" & vbCrLf & vbCrLf
Msg = Msg & "1." & Employee1
Msg = Msg & vbCrLf & vbCrLf & "2." & Employee2
Msg = Msg & vbCrLf & vbCrLf & "3." & Employee3
Msg = Msg & vbCrLf & vbCrLf & "4." & Employee4

OptNum = Application.InputBox(Msg, Title:="Select a workers name", Type:=1)
If OptNum = False Then Exit Sub

Select Case OptNum
    Case 1
        Target.Offset(, 1).Value = Target.Value: Target.Value = ""
    Case 2
        Target.Offset(, 2).Value = Target.Value: Target.Value = ""
    Case 3
        Target.Offset(, 3).Value = Target.Value: Target.Value = ""
    Case 4
        Target.Offset(, 4).Value = Target.Value: Target.Value = ""
End Select
End If
Exit Sub
M:

MsgBox "You failed to enter a Option"



End Sub

This is exactally what I was looking for. The only thing it doesn't do is carry the formatting over to the employee column. So the cells with the jobs in are all bordered and coloured depending on the time of the job. Is it possible to carry the formatting over?

Thanks
Chris

 

[My Aswer Is This]

Try this:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Modified  12/2/2019  9:36:42 PM  EST
If Target.Column = 2 And Target.Row > 3 Then
Cancel = True

On Error GoTo M
Dim Msg As String, OptNum As Variant, Sht As Worksheet
Dim Employee1 As String
Dim Employee2 As String
Dim Employee3 As String
Dim Employee4 As String
Employee1 = Cells(1, 3).Value
Employee2 = Cells(1, 4).Value
Employee3 = Cells(1, 5).Value
Employee4 = Cells(1, 6).Value

Msg = "Enter the option number from the Options below" & vbCrLf & vbCrLf
Msg = Msg & "1." & Employee1
Msg = Msg & vbCrLf & vbCrLf & "2." & Employee2
Msg = Msg & vbCrLf & vbCrLf & "3." & Employee3
Msg = Msg & vbCrLf & vbCrLf & "4." & Employee4

OptNum = Application.InputBox(Msg, Title:="Select a workers name", Type:=1)
If OptNum = False Then Exit Sub

Select Case OptNum
    Case 1
        Target.Copy Target.Offset(, 1): Target.Clear
       
    Case 2
        Target.Copy Target.Offset(, 2): Target.Clear
       
    Case 3
        Target.Copy Target.Offset(, 3): Target.Clear
       
    Case 4
        Target.Copy Target.Offset(, 4): Target.Clear
       
End Select
End If
Exit Sub
M:

MsgBox "You failed to enter a Option"



End Sub