Trying to move horizontal data into vertical data with other fields

richard12

New Member
Joined
Feb 9, 2017
Messages
23
I have lists of vacation times in a spreadsheet with multiple vacation columns that need to be placed, with other data, into a vertical data formatted spreadsheet. This now requires multiple cut/paste into another sheet, then upload to Microsoft Access to create relationships in a query that is copy/pasted into a spreadsheet to get the multiple rows of the same employee with different vacation dates. I would like to eliminate using Access, if possible, and use Excel to get to the sheet that can be used in a program. There is an employee sheet that has rows of employees with their personal data that is used to make a final Excel worksheet. The goal is to make a sheet with the same employee multiple times so vacation weeks can be accounted for and used in a query. See Sheet 2 example below. I am using Excel 2013

Sheet1 from managers
Grp Emp# LastNM FirstNM Vac Week Vac Week Vac Week Vac Week Vac Week Vac
image1.jpg
image 1.jpg
[TABLE="width: 991"]
<colgroup><col><col><col><col><col><col span="5"></colgroup><tbody>[TR]
[TD]02[/TD]
[TD]503941[/TD]
[TD]SMITH[/TD]
[TD]JOHN[/TD]
[TD="align: right"]3/11/2018[/TD]
[TD="align: right"]6/17/2018[/TD]
[TD="align: right"]9/30/2018[/TD]
[TD="align: right"]11/4/2018[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]02[/TD]
[TD]500007[/TD]
[TD]JONES[/TD]
[TD]ANDY[/TD]
[TD="align: right"]1/28/2018[/TD]
[TD="align: right"]2/4/2018[/TD]
[TD="align: right"]4/22/2018[/TD]
[TD="align: right"]7/1/2018[/TD]
[TD="align: right"]11/18/2018[/TD]
[TD="align: right"]11/25/2018[/TD]
[/TR]
[TR]
[TD]02[/TD]
[TD]544899[/TD]
[TD]ANDERSON[/TD]
[TD]MAX[/TD]
[TD="align: right"]4/29/2018[/TD]
[TD="align: right"]5/6/2018[/TD]
[TD="align: right"]5/13/2018[/TD]
[TD="align: right"]12/30/2018[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]03[/TD]
[TD]544671[/TD]
[TD]MAUL[/TD]
[TD]MIKE[/TD]
[TD="align: right"]3/25/2018[/TD]
[TD="align: right"]4/1/2018[/TD]
[TD="align: right"]7/8/2018[/TD]
[TD="align: right"][/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]03[/TD]
[TD]543445[/TD]
[TD]JONES[/TD]
[TD]SAM[/TD]
[TD="align: right"]5/6/2018[/TD]
[TD="align: right"]8/5/2018[/TD]
[TD="align: right"]8/12/2018[/TD]
[TD="align: right"]10/7/2018[/TD]
[TD="align: right"]11/11/2018[/TD]
[TD] [/TD]
[/TR]
</tbody>[/TABLE]

Sheet2 is using manager input and HR employee data from separate pages. I need to somehow have multiple rows of the same data to meet the number of columns of vacation week dates. The purpose is to have this data so the selection of an employee's vacation week might find similar employees, not on vacation, who could substitute for the employee on vacation. The order or format of Sheet 2 is not important if that matters.
[TABLE="width: 456"]
<colgroup><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]EMPLOYEE#[/TD]
[TD]LastNM[/TD]
[TD]FirstNM[/TD]
[TD]ZIP[/TD]
[TD]EstZIP[/TD]
[TD]VacWeek[/TD]
[/TR]
[TR]
[TD]503941[/TD]
[TD]SMITH[/TD]
[TD]JOHN[/TD]
[TD]54126[/TD]
[TD]54344[/TD]
[TD="align: right"]3/11/2018[/TD]
[/TR]
[TR]
[TD]503941[/TD]
[TD]SMITH[/TD]
[TD]JOHN[/TD]
[TD]54126[/TD]
[TD]54344[/TD]
[TD="align: right"]6/17/2018[/TD]
[/TR]
[TR]
[TD]503941[/TD]
[TD]SMITH[/TD]
[TD]JOHN[/TD]
[TD]54126[/TD]
[TD]54344[/TD]
[TD="align: right"]9/30/2018[/TD]
[/TR]
[TR]
[TD]503941[/TD]
[TD]SMITH[/TD]
[TD]JOHN[/TD]
[TD]54126[/TD]
[TD]54344[/TD]
[TD="align: right"]11/4/2018[/TD]
[/TR]
[TR]
[TD]500007[/TD]
[TD]JONES[/TD]
[TD]ANDY[/TD]
[TD]52537[/TD]
[TD]54443[/TD]
[TD="align: right"]1/28/2018[/TD]
[/TR]
[TR]
[TD]500007[/TD]
[TD]JONES[/TD]
[TD]ANDY[/TD]
[TD]52537[/TD]
[TD]54443[/TD]
[TD="align: right"]2/4/2018[/TD]
[/TR]
[TR]
[TD]500007[/TD]
[TD]JONES[/TD]
[TD]ANDY[/TD]
[TD]52537[/TD]
[TD]54443[/TD]
[TD="align: right"]4/22/2018[/TD]
[/TR]
[TR]
[TD]500007[/TD]
[TD]JONES[/TD]
[TD]ANDY[/TD]
[TD]52537[/TD]
[TD]54443[/TD]
[TD="align: right"]7/1/2018[/TD]
[/TR]
[TR]
[TD]500007[/TD]
[TD]JONES[/TD]
[TD]ANDY[/TD]
[TD]52537[/TD]
[TD]54443[/TD]
[TD="align: right"]11/18/2018[/TD]
[/TR]
[TR]
[TD]500007[/TD]
[TD]JONES[/TD]
[TD]ANDY[/TD]
[TD]52537[/TD]
[TD]54443[/TD]
[TD="align: right"]11/25/2018[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Where is ZIP and EstZip coming from?
If it is coming from another sheet, please let us know what sheet that is, and what the structure of that data looks like.
 
Upvote 0
How about
Code:
Sub copyTranspose()
   Dim Sws As Worksheet
   Dim Dws As Worksheet
   Dim Cl As Range
   Dim Qty As Long
   Dim Cols As Long
   
   Set Sws = Sheets("Sheet1")
   Set Dws = Sheets("Sheet2")
   Cols = Sws.Cells(1, Columns.Count).End(xlToLeft).Column - 4
   For Each Cl In Sws.Range("B2", Sws.Range("B" & Rows.Count).End(xlUp))
      Qty = Application.CountA(Cl.Offset(, 3).Resize(, Cols))
      With Dws.Range("A" & Rows.Count).End(xlUp).Offset(1)
         Cl.Resize(, 3).Copy .Resize(Qty)
         .Offset(, 5).Resize(Qty).Value = Application.Transpose(Cl.Offset(, 3).Resize(, Qty))
      End With
   Next Cl
   
End Sub
This will copy the data from sheet1 to sheet2. In order to do the ZIP & EstZIP, we'll need more info
 
Upvote 0
Solution
Amazing how well your VB code worked. Thank you very much. That alone will save so many hours. I'm going to setup the HR employee record sheet in Excel.
How about
Code:
Sub copyTranspose()
   Dim Sws As Worksheet
   Dim Dws As Worksheet
   Dim Cl As Range
   Dim Qty As Long
   Dim Cols As Long
   
   Set Sws = Sheets("Sheet1")
   Set Dws = Sheets("Sheet2")
   Cols = Sws.Cells(1, Columns.Count).End(xlToLeft).Column - 4
   For Each Cl In Sws.Range("B2", Sws.Range("B" & Rows.Count).End(xlUp))
      Qty = Application.CountA(Cl.Offset(, 3).Resize(, Cols))
      With Dws.Range("A" & Rows.Count).End(xlUp).Offset(1)
         Cl.Resize(, 3).Copy .Resize(Qty)
         .Offset(, 5).Resize(Qty).Value = Application.Transpose(Cl.Offset(, 3).Resize(, Qty))
      End With
   Next Cl
   
End Sub
This will copy the data from sheet1 to sheet2. In order to do the ZIP & EstZIP, we'll need more info
 
Upvote 0
Glad we could help & thanks for the feedback
 
Upvote 0
Joe4,Fluff,

This is the HR sheet example. It can be rearranged if necessary as it is just output from a database. To do a step, to use Google maps, I need the HR, other than duplicate, information added to each row of vacation date. Zip is the employee Zip, EstZIP is the workplace zip. The other fields are select or exclude fields to only get those employees who match criteria.

[TABLE="width: 1250"]
<colgroup><col><col><col><col><col><col><col span="2"><col><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]EMPLOYEE#[/TD]
[TD]LastNM[/TD]
[TD]FirstNM[/TD]
[TD]ZIP[/TD]
[TD]EstZIP[/TD]
[TD]Circuit#[/TD]
[TD]Series[/TD]
[TD]Grade[/TD]
[TD]Remarks[/TD]
[TD]IM[/TD]
[TD]RTE/SS[/TD]
[TD]LIVESTOCK[/TD]
[TD]POULTRY[/TD]
[TD]PHV[/TD]
[TD]THERMAL PROCESSING[/TD]
[TD]EPI[/TD]
[TD]NPIS[/TD]
[/TR]
[TR]
[TD]503941[/TD]
[TD]SMITH[/TD]
[TD]JOHN[/TD]
[TD]56007[/TD]
[TD]55912[/TD]
[TD]31[/TD]
[TD]0701[/TD]
[TD]12[/TD]
[TD] [/TD]
[TD]FALSE[/TD]
[TD]TRUE[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]TRUE[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[/TR]
[TR]
[TD]500007[/TD]
[TD]JONES[/TD]
[TD]ANDY[/TD]
[TD]53563[/TD]
[TD]53132[/TD]
[TD]17[/TD]
[TD]0701[/TD]
[TD]12[/TD]
[TD] [/TD]
[TD]FALSE[/TD]
[TD]TRUE[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]TRUE[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[/TR]
[TR]
[TD]544899[/TD]
[TD]ANDERSON[/TD]
[TD]MAX[/TD]
[TD]50707[/TD]
[TD]52204[/TD]
[TD]29[/TD]
[TD]0701[/TD]
[TD]12[/TD]
[TD] [/TD]
[TD]FALSE[/TD]
[TD]TRUE[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]TRUE[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[/TR]
[TR]
[TD]544671[/TD]
[TD]MAUL[/TD]
[TD]MIKE[/TD]
[TD]56082[/TD]
[TD]55336[/TD]
[TD]12[/TD]
[TD]0701[/TD]
[TD]12[/TD]
[TD] [/TD]
[TD]FALSE[/TD]
[TD]TRUE[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]TRUE[/TD]
[TD]TRUE[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[/TR]
[TR]
[TD]543445[/TD]
[TD]JONES[/TD]
[TD]SAM[/TD]
[TD]57350[/TD]
[TD]57399[/TD]
[TD]35[/TD]
[TD]0701[/TD]
[TD]12[/TD]
[TD] [/TD]
[TD]FALSE[/TD]
[TD]TRUE[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]TRUE[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[TD]FALSE[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
How about
Code:
Sub copyTranspose()
   Dim Sws As Worksheet
   Dim Dws As Worksheet
   Dim Hrws As Worksheet
   Dim Fnd As Range
   Dim Cl As Range
   Dim Qty As Long
   Dim Cols As Long
   
   Set Sws = Sheets("Sheet1")
   Set Dws = Sheets("Sheet2")
   Set Hrws = Sheets("HR")
   
   Cols = Sws.Cells(1, Columns.Count).End(xlToLeft).Column - 4
   For Each Cl In Sws.Range("B2", Sws.Range("B" & Rows.Count).End(xlUp))
      Qty = Application.CountA(Cl.Offset(, 3).Resize(, Cols))
      With Dws.Range("A" & Rows.Count).End(xlUp).Offset(1)
         Set Fnd = Hrws.Range("A:A").Find(Cl.Value, , , xlWhole, , , , , False)
         Cl.Resize(, 3).Copy .Resize(Qty)
         .Offset(, 5).Resize(Qty).Value = Application.Transpose(Cl.Offset(, 3).Resize(, Qty))
         .Offset(, 3).Resize(Qty, 2).Value = Fnd.Offset(, 3).Resize(, 2).Value
      End With
   Next Cl
   
End Sub
 
Upvote 0
Fluff - Thanks for the additional VBA, it worked perfectly to place the 2 Zip codes into Sheet 2 and I was able to change ".Offset" in the next to last line to have the date before the Zip codes. I tried to copy the last ".Offset" line and change various numbers to add the rest of the HR data elements to the Sheet 2 final product. That didn't work as I got numbers not in the HR data and N/A for most of my efforts. Is there a way to get all the data after the HR Sheet Zipcodes into Sheet 2 for every record?

At one time, I did see the series in Sheet 2, but that eventually disappeared. However, when the series went into Sheet 2, it dropped the leading "0" as if it was a number. I had all fields in the HR Sheet formatted as Text. I do have a code to add 0's back so it is trivial, just odd. But is there a way to account for this before the transfer?

Most of the time, VB added the VacationDate formats as a number. It is easy to reformat as a date but it seems odd it happens. Do you know if this is normal?

Thank you for the help you have given. I really appreciate knowing there are ways to move data in Excel. I thought VB was difficult in Access, but Excel concepts and coding are really challenging.
 
Upvote 0
Give this a go
Code:
Sub copyTranspose()
   Dim Sws As Worksheet
   Dim Dws As Worksheet
   Dim Hrws As Worksheet
   Dim Fnd As Range
   Dim Cl As Range
   Dim Qty As Long
   Dim Cols As Long
   
   Set Sws = Sheets("Sheet1")
   Set Dws = Sheets("Sheet2")
   Set Hrws = Sheets("HR")
   
   Cols = Sws.Cells(1, Columns.Count).End(xlToLeft).Column - 4
   For Each Cl In Sws.Range("B2", Sws.Range("B" & Rows.Count).End(xlUp))
      Qty = Application.CountA(Cl.Offset(, 3).Resize(, Cols))
      With Dws.Range("A" & Rows.Count).End(xlUp).Offset(1)
         Set Fnd = Hrws.Range("A:A").Find(Cl.Value, , , xlWhole, , , , , False)
         Cl.Resize(, 3).Copy .Resize(Qty)
         .Offset(, 3).Resize(Qty).Value = Application.Transpose(Cl.Offset(, 3).Resize(, Qty))
         Fnd.Offset(, 3).Resize(, 16).Copy .Offset(, 4).Resize(Qty, 16)
         .Offset(, 3).NumberFormat = "mm/dd/yyyy"
      End With
   Next Cl
   
End Sub
 
Upvote 0
Thanks again for your help. The new code worked perfectly. I have been trying the process with the real data, 740 employees and 3471 leave requests with astonishing results. Although I had to add some error code because of errors in data, it only takes a few seconds to merge the two sheets. From hours to seconds is really great. The errors were caused by having employees on the Vacation sheet who had left and were not on the HR sheet. Having the errors show up worked out since the employee data columns had no data, so a quick sort, check, and delete resolved that problem.

Give this a go
Code:
Sub copyTranspose()
   Dim Sws As Worksheet
   Dim Dws As Worksheet
   Dim Hrws As Worksheet
   Dim Fnd As Range
   Dim Cl As Range
   Dim Qty As Long
   Dim Cols As Long
   
   Set Sws = Sheets("Sheet1")
   Set Dws = Sheets("Sheet2")
   Set Hrws = Sheets("HR")
   
   Cols = Sws.Cells(1, Columns.Count).End(xlToLeft).Column - 4
   For Each Cl In Sws.Range("B2", Sws.Range("B" & Rows.Count).End(xlUp))
      Qty = Application.CountA(Cl.Offset(, 3).Resize(, Cols))
      With Dws.Range("A" & Rows.Count).End(xlUp).Offset(1)
         Set Fnd = Hrws.Range("A:A").Find(Cl.Value, , , xlWhole, , , , , False)
         Cl.Resize(, 3).Copy .Resize(Qty)
         .Offset(, 3).Resize(Qty).Value = Application.Transpose(Cl.Offset(, 3).Resize(, Qty))
         Fnd.Offset(, 3).Resize(, 16).Copy .Offset(, 4).Resize(Qty, 16)
         .Offset(, 3).NumberFormat = "mm/dd/yyyy"
      End With
   Next Cl
   
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,790
Messages
6,174,594
Members
452,574
Latest member
hang_and_bang

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top