You'd better use a table ( menu/Insert/table).
Hi Team , I have a multi dimensional table, I want to convert that table into single -D table
This is the type of excel I’ll be working on
In this select the column right next to the orange cell
In which ever cell , if there is “X” value Select the corresponding row. Suppose If I select the column F since its the column right next to Orange color cell,
I'll go for Row 6 and I'll select, Location 1,dsf,Neutral and fruit and paste it in a separate worksheets. Similarly next I'll go for column 6.
Then I'll search for next Orange cell and column right next to it and continue this operation. how should I proceed.
You'd better use a table ( menu/Insert/table).
Hello snb, this is just one small part of the table , is there any way we could automate this by using for the entire table using VBA
Basket - can you amend your sample file so that it also shows how the data looks in the table that you're pasting it to?
So you don't record at all what shop was involved? e.g from the input sheet we can see that the data from that first line came from shop 1 at Walmart. But your output table doesn't record this information. Is there a reason for this?
try this on the active sheet:Code:Sub blah() lr = Cells(Rows.Count, 1).End(xlUp).Row lc = Cells(2, Columns.Count).End(xlToLeft).Column DestnRow = lr + 5 For Each cll In Range(Range("E3"), Cells(lr, lc)).SpecialCells(xlCellTypeConstants, 2).Cells If cll.Value = "X" Then Set RoleCell = Cells(1, cll.Column) Cells(DestnRow, 1).Resize(, 6).Value = Array(IIf(Len(RoleCell.Value) > 0, RoleCell.Value, RoleCell.End(xlToLeft).Value), Cells(cll.Row, 1).Value, Cells(cll.Row, 2).Value, Cells(cll.Row, 3).Value, Cells(cll.Row, 4).Value, Cells(2, cll.Column).Value) DestnRow = DestnRow + 1 End If Next cll End Sub
Have I got it right that the red and orange columns are organisations and columns to the right are shops belonging to that organisation? And that you'll never expect 'X' in those columns?
If so, 2 tweaks to my last offering; one to change the order of the results to make it similar to your screen shot, the other to add a column showing the organisation. If you don't like the last two columns, delete them.(I haven't bothered not searching columns E and H so I hope there are no 'X's in there.)Code:Sub blah4() lr = Cells(Rows.Count, 1).End(xlUp).Row lc = Cells(2, Columns.Count).End(xlToLeft).Column DestnRow = lr + 5 For Each colm In Range(Range("E3"), Cells(lr, lc)).Columns For Each cll In colm.SpecialCells(xlCellTypeConstants, 2).Cells If cll.Value = "X" Then Set RoleCell = Cells(1, cll.Column) If Len(RoleCell.Value) = 0 Then Set RoleCell = RoleCell.End(xlToLeft) Cells(DestnRow, 1).Resize(, 7).Value = Array(RoleCell.Value, Cells(cll.Row, 1).Value, Cells(cll.Row, 2).Value, Cells(cll.Row, 3).Value, Cells(cll.Row, 4).Value, RoleCell.Offset(1).Value, Cells(2, cll.Column).Value) DestnRow = DestnRow + 1 End If Next cll Next colm End Sub
(The results are 5 rows below the table.)
Last edited by p45cal; 2014-08-23 at 03:10 PM.
Code:Sub M_snb() On Error Resume Next With Sheet1.Cells(1).CurrentRegion For j = 5 To .Columns.Count .AutoFilter j, "X" If .Columns(1).SpecialCells(12).Count > 1 Then x2 = Sheets(LCase(Sheet1.Cells(2, j).Value)).Cells(1).Value If Err.Number <> 0 Then Sheets.Add(, Sheets(Sheets.Count)).Name = LCase(Sheet1.Cells(2, j).Value) Err.Clear .Offset(1).Copy Sheets(Sheet1.Cells(2, j).Value).Cells(Rows.Count, 1).End(xlUp).Offset(1) End If .AutoFilter Next End With End Sub
Bookmarks