Macro needed to copy selected cell data from one sheet to another sheet selcted cell

[savethisid]

Hi there,

Would really appreciate if somebody could find a solution to my problem. I am trying to make a shift change/exchange request file for my employees.

The employee would use this file to put in there shift change request from Morning to Evening or from Night to Morning (any) for a specific date or date range.

As soon as the employee clicks submit, the data should be transferred to second sheet (in this case: Only to be seen by Admin) to the specified cells, and the request entry should get deleted from the first sheet (in this case Request Sheet) for fresh entries.

Need this data for a total of 100 employees and as and when the request is put forward, what the macro should be able to do is

a) pick Employee Code from (request sheet)
b) match the same on the sheet (Only to be seen by admin)
c) once it matches the criteria come back to (request sheet) - pick date against the column change/exchange requested from to) and paste the data in required cell in sheet (only to be seen by admin)
d) comes back to sheet (request sheet) pick the employee name and with whom exchange has been requested for. (if cell left blank) puts (-) in appropriate cell in sheet (only to be seen by admin)

Hope i was able to explain. For easy navigation and understanding, I am attaching herewith the file in discussion.

please help

[arlu1201]

Should the data be input into the section corresponding to the request date in the admin tab (row3)?

[savethisid]

Hi Arlette,

Hey thanks a ton !! yes you are right, the data should feature/pasted on the corresponding column next the respective E.Code (as shown in the admin tab sheet)

[arlu1201]

So you have like 5 columns per date in the admin file. Is this report monthly?

[savethisid]

Yes you are right, have 5 columns per date and yes has to be reported monthly :-)

[savethisid]

Hi there,

Was i able to help you out with my answer?

[savethisid]

Urgently required please help

[savethisid]

Hi Arul, kindly help yaar, need this badly, stuff not moving ahead...

[arlu1201]

Hey, have asked some of our experts to help you with this one.

[tigeravatar]

savethisid,

Attached is a modified version of your example workbook. In the 'Request Form' sheet is a form control button named Submit which has been assigned to the following macro:

Sub btn_Submit_Click()
    
    Dim wsReq As Worksheet  'Request worksheet (Request Form)
    Dim wsSch As Worksheet  'Schedule worksheet (Only to be seen by Admin)
    Dim rngFindName As Range
    Dim rIndex As Long
    Dim strName As String
    
    Set wsReq = ActiveSheet
    Set wsSch = Sheets("Only to be seen by Admin")
    
    If Trim(wsReq.Range("C7").Value) = vbNullString Then
        wsReq.Range("C7:D8").Select
        MsgBox "No employee code provided.", , "Shift Request Error"
        Exit Sub
    End If
    
    Set rngFindName = wsSch.Columns("C").Find(wsReq.Range("C7").Value, , , xlWhole)
    If Not rngFindName Is Nothing Then
        rIndex = rngFindName.Row
        strName = Trim(wsReq.Range("I6").Value)
        If strName = vbNullString Then strName = "(-)"
        wsSch.Cells(rIndex, Columns.Count).End(xlToLeft).Offset(, 1).Resize(, 5).Value = _
            Array(wsReq.Range("C10").Text, wsReq.Range("F10").Text, wsReq.Range("C16").Value, wsReq.Range("C19").Value, strName)
        'wsReq.Range("C4,C7,C10,,C13,C16,C19,C23,F10,I6,J10,J14").ClearContents
        wsReq.Range("C4:E5,C7:D8,C10:D11,C13:D14,C16:D17,C19:D20,C23:L26,F10:G11,I6:K7,J10:K11,J14:K15").ClearContents
        wsReq.Range("C4:E5").Select
    Else
        wsReq.Range("C7:D8").Select
        MsgBox "Employee Code [" & wsReq.Range("C7").Value & "] not found.", , "Shift Request Error"
    End If
    
End Sub

[savethisid]

No words but just a big thank you to both Aurl and TigerAvatar, really you've been a great help...thanks a million :-)) It's working fine as of now, would try out for now and get back to you in a day or two...superb stuff...thanks once again. :-)

[savethisid]

Hi tigeravtar,

Sorry Sorry :-( Just realized I missed out the comment that the employee insertes in the Request Form, the most important thing is knowing the reason why shift change was requested?
hence wanted that the comment too is added into the second tab "Only to be seen by Admin" next or after "With" insterting a column. Please see the example below

From - To - A.Shift - R.Shift - With - Comment || From - To - A.Shift - R.Shift - With - Comment || From - To - A.Shift - R.Shift - With - Comment ||

would really appreciate if you could fix this small thing for me.

Thanks

[tigeravatar]

savethisid,

You can run this macro to add the "Reason" columns to each section in the "Only to be seen by Admin" sheet:

Sub InsertReasonCols()
    
    Dim rngInsert As Range
    Dim rngFound As Range
    
    With Sheets("Only to be seen by Admin")
        Set rngFound = .Range("E4", .Cells(4, Columns.Count)).Find("From", , , xlWhole)
        If Not rngFound Is Nothing Then
            Set rngInsert = rngFound
            Do While Not rngFound Is Nothing
                Set rngInsert = Union(rngInsert, rngFound)
                Set rngFound = .Range("E4", .Cells(4, Columns.Count)).Find("From", rngFound, , xlWhole)
                If Not Intersect(rngFound, rngInsert) Is Nothing Then Exit Do
            Loop
            rngInsert.EntireColumn.Insert
            rngInsert.Offset(, -1).Value = "Reason"
        End If
    End With
    
End Sub

Here's a slightly updated version of the previous macro, to include the Reason for change from the Request Form sheet:

Sub btn_Submit_Click()
    
    Dim wsReq As Worksheet  'Request worksheet (Request Form)
    Dim wsSch As Worksheet  'Schedule worksheet (Only to be seen by Admin)
    Dim rngFindName As Range
    Dim rIndex As Long
    Dim strName As String
    
    Set wsReq = ActiveSheet
    Set wsSch = Sheets("Only to be seen by Admin")
    
    With wsReq
        If Trim(.Range("C7").Value) = vbNullString Then
            .Range("C7:D8").Select
            MsgBox "No employee code provided.", , "Shift Request Error"
            Exit Sub
        End If
        
        Set rngFindName = wsSch.Columns("C").Find(.Range("C7").Value, , , xlWhole)
        If Not rngFindName Is Nothing Then
            rIndex = rngFindName.Row
            strName = Trim(.Range("I6").Value)
            If strName = vbNullString Then strName = "(-)"
            wsSch.Cells(rIndex, Columns.Count).End(xlToLeft).Offset(, 1).Resize(, 6).Value = _
                Array(.Range("C10").Text, .Range("F10").Text, .Range("C16").Value, .Range("C19").Value, strName, .Range("C23").Value)
            .Range("C4:E5,C7:D8,C10:D11,C13:D14,C16:D17,C19:D20,C23:L26,F10:G11,I6:K7,J10:K11,J14:K15").ClearContents
            .Range("C4:E5").Select
        Else
            .Range("C7:D8").Select
            MsgBox "Employee Code [" & .Range("C7").Value & "] not found.", , "Shift Request Error"
        End If
    End With
    
End Sub

[savethisid]

Hi,

It worked !!Yahoo!!...thanks a ton...you've made things so easy for me

Thanks once again,

Have A Nice Day