| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Formula/Macro Question
On Nov 12, 9:34*am, Don Guillett wrote:
On Nov 12, 8:29*am, Don Guillett wrote: On Nov 11, 11:49*am, carl wrote: My data table looks like this: Router *Name ABC * * QQQ ABC * * SPY ABC * * GOOG EFG * * QQQ EFG * * GOOG I m trying to create this table: Name * *Router QQQ * * ABC,EFG SPY * * ABC GOOG * *ABC,EFG Thanks in advance. This does it Sub lineemupSAS()Dim lr As LongDim lc As LongDim i As Mailer Range("router").Copy Range("a1")lr = Cells(Rows.Count, 1).End(xlUp).RowColumns(2).CutColumns(1).InsertRan ge("A2:B" & lr).Sort Key1:=Range("a2"), Order1:=xlAscending, _Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom **For i = lr To 1 Step -1If Cells(i + 1, 1) = Cells(i, 1) Then*lc = Cells(i, Columns.Count).End(xlToLeft).Column + 1*Cells(i + 1, 2).Copy Cells(i, lc)*Rows(i + 1).DeleteEnd IfNext iEnd Sub word wrap fixed ========== sub lineemupSAS() Dim lr As Long Dim lc As Long Dim i As long lr = Cells(Rows.Count, 1).End(xlUp).Row Columns(2).CutColumns(1).Insert Range("A2:B" & lr).Sort Key1:=Range("a2"), Order1:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = lr To 1 Step -1 If Cells(i + 1, 1) = Cells(i, 1) Then *lc = Cells(i, Columns.Count).End(xlToLeft).Column + 1 *Cells(i + 1, 2).Copy Cells(i, lc) *Rows(i + 1).Delete End If Next i End Sub- Hide quoted text - - Show quoted text - thanks |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Excel Macro or Formula Question | Excel Worksheet Functions | |||
| Excel 2007 Macro/VB Question DDE Question | Excel Worksheet Functions | |||
| Macro Question formula | Excel Discussion (Misc queries) | |||
| Formula Macro Question | Excel Discussion (Misc queries) | |||
| Excel Formula/Worksheet maybe Macro Question | Excel Worksheet Functions | |||
Hybrid Mode
