Align vertical data horizontally while copying previous columns along

Sokkenpop · #1 01-24-2019, 06:40 AM

Hi everyone,

im looking for a way to transpose my data for formatting into a Gantt chart, using VBA.

The original worksheet has a bit of data in columns A to I, and a few dates (for different milestones of the workload) in J:P

Now I want each date to go in a serperate row, while also copying the data from A:I, and also specifying the date type by coping the header along into a seperate column. I have put a "before" and "after" worksheet in attachments (worksheets 1&2)

I have tried various approaches regarding range transformations, yet to no avail.

the cells in blue need to automatically transcribe to the cells in blue on the second worksheet.

Please help!

regards,

Sok

p45cal · #2 01-24-2019, 08:36 AM

I've just recently responded to a similar request on another forum.
Whilst my answer there is NOT suitable for your purposes, a solution proposed by Paul_Hossler there does fit your purposes.
Here's the link: http://www.vbaexpress.com/forum/show...another-format
ps. there's one line you might prefer not to have in that code:
.Value = UCase(.Value)
(it capitalises the results).

Sokkenpop · #3 01-25-2019, 03:10 AM

Hi there,

thanks or your reply, it helped me greatly along the way.

but.. I have a small problem, I need to find a workaround (not using the userform)

I can provide the specified ranges for the userform inputs, yet i cant seem to make it work by rewriting the code,

(the error msgbox keeps popping up)

regards,

Sok

alpha · #4 01-25-2019, 07:48 AM

You can use this macro (place it in a module):

Code:

Sub macro1()
Dim r As Integer, x As Integer, y As Integer, lk As Integer
With Sheets(2)
.Columns("a:k").Delete
Application.ScreenUpdating = False
.Cells(1, 10) = "Milestone_Date": .Cells(1, 11) = "Milestone_Type"
.Range("j1:k1").Interior.ColorIndex = 3
Sheets(1).Range("a1:i1").Copy .Range("a1:i1")
End With
r = 2: y = 2
Do Until IsEmpty(Sheets(1).Cells(r, 1))
With Sheets(1)
lk = .Cells(r, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(r, 1), .Cells(r, 9)).Copy Sheets(2).Cells(y, 1)
.Range(.Cells(r, 10), .Cells(r, lk)).Copy
End With
With Sheets(2)
.Cells(y, 10).PasteSpecial Transpose:=True
.Range(.Cells(y, 1), .Cells(y + lk - 10, 9)).FillDown
For x = 1 To lk - 9
With .Cells(y, 11)
.Value = "Milestone " & x
.Interior.ColorIndex = 23
End With
y = y + 1
Next x
.Columns("a:k").AutoFit
End With
r = r + 1
Loop
With Application
.CutCopyMode = False
.Goto reference:=Range("a1")
.ScreenUpdating = True
End With
End Sub

Sokkenpop · #5 01-28-2019, 12:52 AM

Hi Alpha,

thanks, code works perfectly!

one small error on my account, there are not 10 milestones, but 7 milestones (and corresponding dates), which line of code specifies to what extent has to be copied over? Ive been running some tests and modifying here and there, cant seem to find the problem.

Thanks in advance,

Sok

alpha · #6 01-28-2019, 04:32 AM

In sheets(1) you have 10 coworkers with each 7 Milestone(dates).
When you have run the macro, then you have (of course) in sheets(2) the same 10 coworkers with each 7 milestone(dates), not 10 !
If you mean you have not 10 but 7 coworkers, then in sheets(1) you must delete the rows 9, 10, and 11 and after that run the macro again.

Sokkenpop · #7 01-28-2019, 04:47 AM

Hi Alpha,

in sheet1, i have 3 columns with additional info that doesnt need to be copied over (to the right of all the dates in sheet1 (columns Q, R, S)).

However, running this macro will also copy these columns over, ruining some of the Sheet2 output and mismatching the results.

does this macro continue to the rightmost column? where can i edit the code to rule this out?

regards,

Sok

alpha · #8 01-28-2019, 05:48 AM

In the macro, replace

Code:

lk = .Cells(r, .Columns.Count).End(xlToLeft).Column

by:

Code:

lk = 16

Sokkenpop · #9 01-28-2019, 11:39 PM

Thanks very much, works perfectly!

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Vertical Text Alignment with Adjacent Columns	kdutrisac	Word Tables	2	06-26-2017 12:38 PM
Copying specific columns of a table to WORD and deleting rows	ffinley	Word VBA	5	12-07-2015 04:01 PM
Copying and pasting values with unequal data columns	grexcelman	Excel Programming	5	12-05-2014 11:36 AM
Vertical align to bottom of cell when row wraps to next page	lausianne	Word Tables	3	02-28-2014 05:20 PM
Copying data from sheet with deleted columns creates blanks	ZGreyArea	Excel	1	11-20-2013 10:12 AM