#1
|
|||
|
|||
Align vertical data horizontally while copying previous columns along
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 |
#2
|
||||
|
||||
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). |
#3
|
|||
|
|||
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 |
#4
|
|||
|
|||
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 |
#5
|
|||
|
|||
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 |
#6
|
|||
|
|||
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. |
#7
|
|||
|
|||
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 |
#8
|
|||
|
|||
In the macro, replace
Code:
lk = .Cells(r, .Columns.Count).End(xlToLeft).Column Code:
lk = 16 |
#9
|
|||
|
|||
Thanks very much, works perfectly!
|
|
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 |