Macro to copy from one sheet to another with options on which column to copy and which column to paste to and more

[tonywatsonhelp]

Hi Everyone,

This seamed easy when I thought it up but is beyond me so please help if you can.

I have a document called "This Hours"

in it I have tabs that are named after the week they represent like "21 November 2017" etc.

every week I send over to my guys a simple excel doc with the names of clients on it and they send back the hours they spent with each client.

I then manually copy this into my "This Hours" Document for the week it represents.

I was thinking of getting a macro to do this for me but need help.

this is what I need.

assumptions are: the only excel documents open are "This Hours" and the one I want to copy from that I wont know the name of?
Both document will be on the sheet I want the data taken from and copied to.

Now heres the problems,
first I will need a way to identify which column I'm coping from and to, I would think a pop up box saying "please enter From Column" and "please enter To Column" with a way to input the column letters would be best.

then once it knows which column to copy from it cant just copy every row, it needs to look down that column until it finds a cell that is not empty then look at the name in Column C
goto the "This hours" doc look down column C to find the name and paste the data into that cell of the column I suggested?

table below to help show what I mean
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD="align: center"]Message Box[/TD]
[TD]Reply Area[/TD]
[/TR]
[TR]
[TD="align: right"]Please Enter From Column[/TD]
[TD]G[/TD]
[/TR]
[TR]
[TD="align: right"]Please Enter To Column[/TD]
[TD]E
[/TD]
[/TR]
</tbody>[/TABLE]






So I input into the reply area,
the macro then find the other open workbook selects it (as I say I don't know its name)
on the sheets that's open Looks down Column G for data

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD][/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[TD]H
[/TD]
[TD]I
[/TD]
[TD]J
[/TD]
[TD]K
[/TD]
[TD]L
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]HEADINGS
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]MORE HEADINGS
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]MORE HEADINGS
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]MORE HEADINS
[/TD]
[TD][/TD]
[TD]Client
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]STARTS FROM HERE!
[/TD]
[TD][/TD]
[TD]Woolys
[/TD]
[TD][/TD]
[TD]12
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Henley
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]11
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Boots
[/TD]
[TD]14
[/TD]
[TD][/TD]
[TD][/TD]
[TD]16
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Clarks
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]15
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Ravens
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10
[/TD]
[TD][/TD]
[TD][/TD]
[TD]superdrug
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Toy R Us
[/TD]
[TD][/TD]
[TD][/TD]
[TD]
[/TD]
[TD]11
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]12
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Tv Store
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]11
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]13
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Currys
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]12
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]14
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Maplin
[/TD]
[TD][/TD]
[TD]11
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]15
[/TD]
[TD][/TD]
[TD]
[/TD]
[TD]Palins
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]11
[/TD]
[TD][/TD]
[TD][/TD]
[TD]1
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Sams
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Tents
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]11
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]18
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]19
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
So as you can see we have 3 lots of data in column G that needs the be copied
So It then goes back to "This Hours" document current sheet,
Looks Down column C and finds "Boots" and adds the data to Column "E" of that row and does the same for the reast.

Please help if you can

Thanks

Tony

 

[AFPathfinder]

It does sound like that task would be best handled by a macro. I'm sure this will need a little tweaking to get it working, but I think this gets us close.

This is designed to be run out of your PERSONAL.xlsb file when you have the submitted workbook open and active (the one your transferring hours from). This allows it to function without a hardcoded workbook name or separate function to pick the workbook. This also allows you to have other workbooks open.

Assumptions:

• The This Hours workbook is open.
• The client names in either workbook are unique without duplicates in their respective table.
• Client names in the submission workbook are in column C.
• The tables in both workbooks are in the first indexed worksheet of their workbook.
• User always picks the correct columns (would require manual correction if an error is made; i.e. exit workbook without saving).
• The cell the hours are being entered into is always empty (doesn't check for possible data loss).

Sub HoursTransfer()
    Dim oSubmitWks As Worksheet
    Dim oMasterWks As Worksheet
    Dim i As Integer
    Dim k As Integer
    Dim n As Integer
    Dim x As Integer
    Dim sClients As String
    Dim colFrom As String
    Dim colTo As String
    Dim finalRowSubmit As Integer
    
    Set oSubmitWks = ActiveWorkbook.Sheets(1)
    Set oMasterWks = Workbooks("This Hours.xlsx").Sheets(1)
    finalRowSubmit = Cells(Rows.Count, 3).End(xlUp).Row
    
    colFrom = InputBox("Please enter the column letter of the column you " _
        & "wish to transfer FROM.", "Select the FROM column", vbOKCancel)
    If colFrom = "" Then Exit Sub
    
    colTo = InputBox("Please enter the column letter of the column you wish " _
        & "to transfer TO.", "Select the TO column", vbOKCancel)
    If colTo = "" Then Exit Sub
        
    For i = 5 To finalRowSubmit
        If Range(colFrom & i).Value <> "" Then
            On Error GoTo MissingClient
            x = oMasterWks.Columns(1).Find(What:=oSubmitWks.Cells(i, 3).Value, After:=oMasterWks.Cells(1, 1), _
                LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=True).Row
            On Error GoTo 0
            
            oMasterWks.Range(colTo & x).Value = oSubmitWks.Range(colFrom & i)
            n = n + 1
        End If
NextClient:
    Next i
    
    MsgBox "The import has completed." & vbCr & vbCr & n & " clients have had their hours updated." _
        & IIf(k > 0, vbCr & k & " clients were not found on the This Hours workbook:" & sClients, "")
        
    Exit Sub
MissingClient:
    k = k + 1
    sClients = sClients & vbCr & vbTab & oSubmitWks.Cells(i, 3).Value
    Resume NextClient
End Sub

I threw a little extra in there to inform the user if some of the clients weren't found in the main workbook. Give this a whirl and let me know if we need to adjust anywhere.

 

[tonywatsonhelp]

Hi AFPathfinder,
This is a great bit of code,
Its not a problem that I have to tweak it a little as I can do that no problem but if it works as I read it I think I will be fine.

Thank you so much for your help

Tony

 

[AFPathfinder]

You're welcome!