Pull Specific Data from one Sheet to Another using Macro

[MarkHutch]

Hi

I was wondering if anyone was able to help. I have a set of data in one Sheet and I need specific Data from that sheet moved to a second sheet and a comment added. So For example Sheet 1 has Columns A through E with all employees data. I would need this data moved to sheet 2, which has those columns plus extras through to column K. But I would need only specific employee’s info. This I’m hoping could be done by say ID and for instance take only 50012345 John Smith and 50098765 Adam Apples (along with the rest of the relevant info for dates, start time and finish time. Column F is then normally blank. For those same specific employees, I would need this to be populated with the word ‘Travel’. Then again in the comments section, a comment would need to be added, which is again specific to the employee (ID number). Is this possible to do with a macro? Right now we are having to manually do this and it takes ages.
Some data may also already exist in Sheet 2, Would it be possible for any new data being brought into this to be applied under the data already in there. Or would it need to be a completely different sheet and then a copy and paste done?

Any assistance you can provide would be greatly appreciated. This is doing my head in
Thanks

Safe journeys

Mark
[TABLE="width: 0"]
<tbody>[TR]
[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]
[/TR]
[TR]
[TD]Name
[/TD]
[TD]ID
[/TD]
[TD]NA Date
[/TD]
[TD]StartTime
[/TD]
[TD]FinishTime
[/TD]
[TD]NonAvailability
[/TD]
[TD]CommentText
[/TD]
[TD]Street
[/TD]
[TD]City
[/TD]
[TD]PostCode
[/TD]
[TD]CountryID
[/TD]
[/TR]
[TR]
[TD]John Smith
[/TD]
[TD]50012345
[/TD]
[TD]15/07/2016
[/TD]
[TD]00:00
[/TD]
[TD]08:59
[/TD]
[TD]Travel
[/TD]
[TD]Gone Shopping
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]John Smith
[/TD]
[TD]50012345
[/TD]
[TD]16/07/2016
[/TD]
[TD]00:00
[/TD]
[TD]23:59
[/TD]
[TD]Travel
[/TD]
[TD]Gone Shopping
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]John Smith
[/TD]
[TD]50012345
[/TD]
[TD]17/07/2016
[/TD]
[TD]00:00
[/TD]
[TD]23:59
[/TD]
[TD]Travel
[/TD]
[TD]Gone Shopping
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]John Smith
[/TD]
[TD]50012345
[/TD]
[TD]18/07/2016
[/TD]
[TD]00:00
[/TD]
[TD]08:59
[/TD]
[TD]Travel
[/TD]
[TD]Gone Shopping
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Bob Brown
[/TD]
[TD]50076543
[/TD]
[TD]01/08/2016
[/TD]
[TD]17:00
[/TD]
[TD]23:59
[/TD]
[TD]Travel
[/TD]
[TD]Visiting Parents
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Bob Brown
[/TD]
[TD]50076543
[/TD]
[TD]02/08/2016
[/TD]
[TD]00:00
[/TD]
[TD]08:59
[/TD]
[TD]Travel
[/TD]
[TD]Visiting Parents
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Bob Brown
[/TD]
[TD]50076543
[/TD]
[TD]02/08/2016
[/TD]
[TD]17:00
[/TD]
[TD]23:59
[/TD]
[TD]Travel
[/TD]
[TD]Visiting Parents
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Bob Brown
[/TD]
[TD]50076543
[/TD]
[TD]03/08/2016
[/TD]
[TD]00:00
[/TD]
[TD]08:59
[/TD]
[TD]Travel
[/TD]
[TD]Visiting Parents
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Adam Apples
[/TD]
[TD]50098765
[/TD]
[TD]27/07/2016
[/TD]
[TD]17:00
[/TD]
[TD]23:59
[/TD]
[TD]Travel
[/TD]
[TD]Gone Fishing
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Adam Apples
[/TD]
[TD]50098765
[/TD]
[TD]28/07/2016
[/TD]
[TD]00:00
[/TD]
[TD]08:59
[/TD]
[TD]Travel
[/TD]
[TD]Gone Fishing
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Adam Apples
[/TD]
[TD]50098765
[/TD]
[TD]28/07/2016
[/TD]
[TD]17:00
[/TD]
[TD]23:59
[/TD]
[TD]Travel
[/TD]
[TD]Gone Fishing
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Adam Apples
[/TD]
[TD]50098765
[/TD]
[TD]29/07/2016
[/TD]
[TD]00:00
[/TD]
[TD]08:59
[/TD]
[TD]Travel
[/TD]
[TD]Gone Fishing
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Adam Apples
[/TD]
[TD]50098765
[/TD]
[TD]29/07/2016
[/TD]
[TD]17:00
[/TD]
[TD]23:59
[/TD]
[TD]Travel
[/TD]
[TD]Gone Fishing
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[Fluff]

Are the IDs you want to copy over always the same?
If not, how is it determined?
Is the comment always the same for a specific employee, or can that change?

 

[MarkHutch]

Hi, the ID for the employee remains the same, its their employee ID Number, as does the comment for that employee. Basically I have a list of 30 employees with their own unique ID number. The macro would need to pull their details from the one sheet and put it on the other. Then add the word Travel to column F for each of those. Then add the respective comment in column G which is unique to each employee and their ID. Does that make sense?

 

[Fluff]

In your example, you said

50012345 John Smith and 50098765 Adam Apples

Would it always be those 2 IDs, or will the IDs to copy change every time you run the macro?

 

[MarkHutch]

There are 30 ID's. So it would need to search the data in Sheet1 and pull all data in first columns (A-E) for any matches to those ID's. The ID's will stay the same unless people left or we had new starter.
Then it would add the word Travel to the next column and the comments specific to that ID in the next column.

 

[Fluff]

Where are these 30 IDs stored? and where are the comments stored?

 

[MarkHutch]

you could use like 001 to 0030 for example ID's. I'm sure its then possible to edit it with the correct ID numbers. Column F would always be 'Travel'. Then Column G could be 'Comment1' to 'Comment30'. Again as long as it would be possible to then edit it with the correct comment.
Really appreciate your help with this

 

[MarkHutch]

At the moment they are stored just on a separate excel spreadsheet

 

[MarkHutch]

I got an email that said another message was posted here at 15:00 but cant find it

 

[Fluff]

How about

Sub CopyFromList()

   Dim NxtRw As Long
   Dim Usdrws As Long
   Dim Ary As Variant
   Dim Cnt As Long
   
   NxtRw = Sheets("[COLOR=#ff0000]Sheet2[/COLOR]").Range("A" & Rows.Count).End(xlUp).Offset(1).row
   With Sheets("[COLOR=#ff0000]ID[/COLOR]")
      Ary = Application.Transpose(.Range("A2", .Range("A" & Rows.Count).End(xlUp)))
   End With
   
   For Cnt = LBound(Ary) To UBound(Ary)
      Ary(Cnt) = CStr(Ary(Cnt))
   Next Cnt
      
   With Sheets("Source")
      If .AutoFilterMode Then .AutoFilterMode = False
      .Range("A1:E1").AutoFilter 2, Ary, xlFilterValues
      .Range("A2:E" & .Range("B" & Rows.Count).End(xlUp).row).SpecialCells(xlVisible).Copy Sheets("[COLOR=#ff0000]Sheet2[/COLOR]").Range("A" & NxtRw)
      .AutoFilterMode = False
   End With
   
   With Sheets("[COLOR=#ff0000]Sheet2[/COLOR]")
      Usdrws = .Range("A" & Rows.Count).End(xlUp).row
      .Range("F" & NxtRw & ":F" & Usdrws).Value = "Travel"
      With .Range("G" & NxtRw & ":G" & Usdrws)
         .FormulaR1C1 = "=VLOOKUP(rc[-5],[COLOR=#ff0000]ID[/COLOR]!r2c1:r30c2,2,FALSE)"
         .Value = .Value
      End With
   End With

End Sub

Change Sheet names in red to suit.
You'll need a sheet set up like this, for your IDs & comments.

Excel 2013 32 bit
	A	B
1	ID	Comment
2	29221	Peartree
3	42644	Ladywood
4	38534	Sparkbrook
5	29231	Edgbaston
6	32051	Cofton
7	35765	Lickey Hills
8	31503	Slideslow
9	36678	Avoncroft
10	35947	Charford
11	34700	Langley
12	37438	Kingsbury
13	30011	Fazeley
14	37469	Sheldon
15	37653	Elmdon
16	42217	Kingsmead
17	38838	Weston
18	34182	Lambridge
19	41821	Newbridge
20	38504	Frome
21	37622	Mere
22	42401	Warminster
23	38412	Trowbridge
24	31594	Melksham
25	40422	Hilperton
26	37895	Ethandune
27	35400	Southwick
28	38353	Timsbury
29	34881	Oldfield
30	38718	Westmoreland
ID

As for the email, Who did it say had responded?