Spread sheet table into list that updates

[marktwo]

Hello there, Here's my query I have a Spreadsheet table with entries per month that I want to turn into a list that updates with new information as it is entered - this far I have been able to get BUT I don't want to see the nil or Zero entries in my list as it makes it too bulky see example below (as I'd like to see it working new entry in red):

Spreadsheet

Jan Feb Mar Apr
A 1 11 20 31
B 2 21 32
C 12 22
D 3 13 33

List

Jan
A 1
B 2
D 3

Feb
A 11
C 12
D 13

Mar
B 21
C 22

Apr
A 31
B 32
D 33

New Entry For March updates to:
Mar
A 20
B 21
C 22

I have tried a filter but this doesn't update?

Am I missing something or is there an elegant solution??


Many thanks in advance

Marktwo

 

[Andrew Poulsom]

Welcome to MrExcel.

Formulas in G2:H2 copied down as far as you think they will be needed:

Excel 2010
	A	B	C	D	E	F	G	H
1		Jan	Feb	Mar	Apr		Jan
2	A	1	11	20	31		A	1
3	B	2		21	32		B	2
4	C		12	22			D	3
5	D	3	13		33
Sheet1

Cell Formulas
Range	Formula
G2	{=IFERROR(INDEX($A$2:A$5,SMALL(IF(INDEX(B$2:E$5,0,MATCH($G$1,B$1:E$1,FALSE))<>"",ROW(A$2:A$5)-ROW(A$2)+1),ROWS(G$2:G2))),"")}
H2	{=IFERROR(INDEX(INDEX(B$2:E$5,0,MATCH($G$1,B$1:E$1,FALSE)),SMALL(IF(INDEX(B$2:E$5,0,MATCH($G$1,B$1:E$1,FALSE))<>"",ROW(A$2:A$5)-ROW(A$2)+1),ROWS(G$2:G2))),"")}
Press CTRL+SHIFT+ENTER to enter array formulas.

 

[Oeldere]

Run this macro on a dummy of your sheet

Sub CONVERTROWSTOCOL_Oeldere_revisted_new()

Dim rsht1 As Long, rsht2 As Long, I As Long, col As Long, wsTest As Worksheet, mr As Worksheet, ms As Worksheet

'check if sheet "ouput" already exist

Const strSheetName As String = "Output"                      'I had to add this row

Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0
 
If wsTest Is Nothing Then
    Worksheets.Add.Name = strSheetName
End If

'set the data
                 

Set mr = Sheets("sheet1")                                  'this is the name of the source sheet
 
Set ms = Sheets("Output")                                       'this is the name of the destiny sheet

col = 2
'End set the data

    With ms
     .UsedRange.ClearContents
     .Range("A1:C1").Value = Array("Issue", "Month", "value")
    End With
    
    rsht2 = ms.Range("A" & Rows.Count).End(xlUp).Row
    
    
    With mr
          rsht1 = .Range("A" & .Rows.Count).End(xlUp).Row
          For I = 2 To rsht1
                Do While .Cells(1, col).Value <> "" 'And .Cells(I, col).Value <> ""
                rsht2 = rsht2 + 1
               
                ms.Range("A" & rsht2).Value = .Range("A" & I).Value
                
                ms.Range("B" & rsht2).Value = .Cells(1, col).Value
                
                ms.Range("C" & rsht2).Value = .Cells(I, col).Value
         
                col = col + 1
            Loop
            col = 2
        Next
    End With
    
  With ms
    .Range("C2:C" & .Rows.Count).SpecialCells(4).EntireRow.Delete
    
    .Range("C2:C" & .Rows.Count).RemoveDuplicates , Header:=xlYes
    
   
    .Columns("A:Z").EntireColumn.AutoFit
    
    End With
    
End Sub

 

[Peter_SSs]

Welcome to the MrExcel board!

If you want the list layout shown without multiple empty rows if a particular month has no, or few, entries then I don't think a formula solution would be feasible.

I'm suggesting a macro using the Worksheet_Change event so the list should update automatically whenever something is changed in the data area.
Test in a copy of your workbook.

To implement ..

1. Right click the sheet name tab and choose "View Code".

2. Copy and Paste the code below into the main right hand pane that opens at step 1.

3. Close the Visual Basic window & test.

4. If using Excel 2007 or later your workbook will need to be saved as a macro-enabled workbook (*.xlsm)

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim cols As Long, rws As Long, i As Long, j As Long, k As Long
  Dim a, b
  
  Const DataRows As String = "1:5"  '<- Rows to monitor, include header row
  Const ListHeaderRow As Long = 7  '<- Row the word 'List' is in
  
  If Not Intersect(Target, Rows(DataRows)) Is Nothing Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    rws = Rows(DataRows).Rows.Count
    cols = Cells(1, Columns.Count).End(xlToLeft).Column
    a = Rows(DataRows).Resize(, cols).Value
    ReDim b(1 To cols * rws, 1 To 2)
    For j = 2 To cols
      k = k + 2
      b(k, 1) = a(1, j)
      For i = 2 To cols
        If a(i, j) <> "" Then
          k = k + 1
          b(k, 1) = a(i, 1)
          b(k, 2) = a(i, j)
        End If
      Next i
    Next j
    Range("A" & ListHeaderRow + 1, Range("A" & Rows.Count).End(xlUp)).Resize(, 2).ClearContents
    Cells(ListHeaderRow + 1, 1).Resize(k, 2).Value = b
    Application.ScreenUpdating = True
    Application.EnableEvents = True
  End If
End Sub

Entering the data shown in rows 1:5 produces the output in rows 9 onwards.

Excel Workbook
	A	B	C	D	E	F
1		Jan	Feb	Mar	Apr
2	A	1	11		31
3	B	2		21	32
4	C		12	22*
5	D	3	13		33
6
7	List
8
9	Jan
10	A	1
11	B	2
12	D	3
13
14	Feb
15	A	11
16	C	12
17	D	13
18
19	Mar
20	B	21
21	C	22*
22
23	Apr
24	A	31
25	B	32
26	D	33
27
Update List

Then entering 20 in cell D2 produces this:

Excel Workbook
	A	B	C	D	E	F
1		Jan	Feb	Mar	Apr
2	A	1	11	20	31
3	B	2		21	32
4	C		12	22*
5	D	3	13		33
6
7	List
8
9	Jan
10	A	1
11	B	2
12	D	3
13
14	Feb
15	A	11
16	C	12
17	D	13
18
19	Mar
20	A	20
21	B	21
22	C	22*
23
24	Apr
25	A	31
26	B	32
27	D	33
28
Update List

 

[marktwo]

Thank you all very much. I shall have a go, wish me luck. ta

 

[Peter_SSs]

... wish me luck. ta

Good luck!