 |
 | Home | Contact Us | FAQ | Search & Site Map | Link to Us |
 | Sign In | Join | Other 45 Sites in Network |
| HomeDiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWordDirectoryUser Groups Related Topics Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ... |
MS Office Forum / Excel / General Excel Questions / May 2008transpose data
Hi There, I would really appreciate some help on the next subject: How do I transpose This: 1 1 2 2 3 3 To: 1 1 2 2 3 3 This is a (Combined?) Transpose of 1 Column into Rows, where the data decides how many Columns I need.... Many Thanks in advance!!! Hi, If I understand your requirements correctly try this. Because it deletes data try on a test workbook first. Right click the sheet tab, view code and paste this in and run it. Sub transpose() Dim deleterange As Range lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row For x = 2 To lastrow Step 2 Cells(x, 1).Offset(-1, 1).Value = Cells(x, 1).Value If deleterange Is Nothing Then Set deleterange = Cells(x, 1).Resize(, 2) Else Set deleterange = Union(deleterange, Cells(x, 1).Resize(, 2)) End If Next If Not deleterange Is Nothing Then deleterange.Delete Shift:=xlUp End If End Sub Mike > Hi There, > I would really appreciate some help on the next subject: [quoted text clipped - 15 lines] > > Many Thanks in advance!!! Thank You Very much indeed Mike, I think I didn't make myself understood, I am trying to covert a Column into as many Columns as there is Data: From: 1 1 2 2 2 3 4 4 To (Multiple Columns): 1 1 (Entry "1" appears 2x) 2 2 2 (Entry "2" appears 3x) 3 (Entry "3" appears 1x) 4 4 (Entry "4" appears 2x) Etcetera. Any help is Greatly appreciated. Many Thanks, Hilvert > Hi, > [quoted text clipped - 39 lines] > > > > Many Thanks in advance!!! Hi, A bit more involved bit I think we got there Sub transpose() Dim deleterange As Range lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row Max = Application.WorksheetFunction.CountIf(Range("A1:A" & lastrow), _ Application.WorksheetFunction.Mode(Range("A1:A" & lastrow))) col = 1 oset = -1 For x = 2 To lastrow If Cells(x, 1).Value = Cells(x - 1, 1).Value Then Cells(x, 1).Offset(oset, col).Value = Cells(x, 1).Value col = col + 1 oset = oset - 1 If deleterange Is Nothing Then Set deleterange = Cells(x, 1).Resize(, Max) Else Set deleterange = Union(deleterange, Cells(x, 1).Resize(, Max)) End If Else col = 1 oset = -1 End If Next If Not deleterange Is Nothing Then deleterange.Delete Shift:=xlUp End If End Sub Mike > Thank You Very much indeed Mike, > I think I didn't make myself understood, [quoted text clipped - 63 lines] > > > > > > Many Thanks in advance!!! Many Thanks Mike, That's a Great help!!! Hilvert > Hi, > [quoted text clipped - 96 lines] > > > > > > > > Many Thanks in advance!!! Your welcome and thanks for the feedback > Many Thanks Mike, > That's a Great help!!! [quoted text clipped - 100 lines] > > > > > > > > > > Many Thanks in advance!!! |
Reply to this Message |
 Sign In
 Join
 My Latest Posts My Monitored Threads My Blog My Photo Gallery My Profile My Homepage Start New Thread Enable EMail Alerts Rate this Thread
|
©2008 Advenet LLC Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.