Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Excel > Excel Programming

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 01-24-2019, 06:40 AM
Sokkenpop Sokkenpop is offline Windows 10 Office 2016
Novice
 
Join Date: Jan 2019
Location: NB, Netherlands
Posts: 7
Sokkenpop is on a distinguished road
Default 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
Attached Files
File Type: xlsx tester(datetransformation).xlsx (11.7 KB, 3 views)
Reply With Quote
  #2  
Old 01-24-2019, 08:36 AM
p45cal p45cal is offline Windows 10 Office 2016
Competent Performer
 
Join Date: Apr 2014
Posts: 209
p45cal will become famous soon enough
Default

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).
Reply With Quote
  #3  
Old 01-25-2019, 03:10 AM
Sokkenpop Sokkenpop is offline Windows 10 Office 2016
Novice
 
Join Date: Jan 2019
Location: NB, Netherlands
Posts: 7
Sokkenpop is on a distinguished road
Default

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
Reply With Quote
  #4  
Old 01-25-2019, 07:48 AM
alpha alpha is offline Windows 10 Office 2010 64bit
Novice
 
Join Date: Jun 2018
Posts: 15
alpha is on a distinguished road
Default

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
Reply With Quote
  #5  
Old 01-28-2019, 12:52 AM
Sokkenpop Sokkenpop is offline Windows 10 Office 2016
Novice
 
Join Date: Jan 2019
Location: NB, Netherlands
Posts: 7
Sokkenpop is on a distinguished road
Default

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
Reply With Quote
  #6  
Old 01-28-2019, 04:32 AM
alpha alpha is offline Windows 10 Office 2010 64bit
Novice
 
Join Date: Jun 2018
Posts: 15
alpha is on a distinguished road
Default

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.
Reply With Quote
  #7  
Old 01-28-2019, 04:47 AM
Sokkenpop Sokkenpop is offline Windows 10 Office 2016
Novice
 
Join Date: Jan 2019
Location: NB, Netherlands
Posts: 7
Sokkenpop is on a distinguished road
Default

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
Reply With Quote
  #8  
Old 01-28-2019, 05:48 AM
alpha alpha is offline Windows 10 Office 2010 64bit
Novice
 
Join Date: Jun 2018
Posts: 15
alpha is on a distinguished road
Default

In the macro, replace
Code:
lk = .Cells(r, .Columns.Count).End(xlToLeft).Column
by:
Code:
lk = 16
Reply With Quote
  #9  
Old 01-28-2019, 11:39 PM
Sokkenpop Sokkenpop is offline Windows 10 Office 2016
Novice
 
Join Date: Jan 2019
Location: NB, Netherlands
Posts: 7
Sokkenpop is on a distinguished road
Default

Thanks very much, works perfectly!
Reply With Quote
Reply

Thread Tools
Display Modes


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


All times are GMT -7. The time now is 05:48 AM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft