Macro to turn a grid of data into a list of data

T

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
3,210
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
Hi Everyone,

I have a grid of data with names along the top and sales down the side in Sheet "Data" (see chart1)
I want to convert this data into a list in Sheet "New Data" (see chart 2)

I just can't get anything to work so please help

I figure its best if I show you an example so here is a small example of what I want:

What I have :
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD][/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[TD]H
[/TD]
[TD]I
[/TD]
[TD]J
[/TD]
[TD]K
[/TD]
[TD]L
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]DATE
[/TD]
[TD]12/06/2017
[/TD]
[TD]SALES PERSON
[/TD]
[TD]Terry
[/TD]
[TD]Sue
[/TD]
[TD]Mat
[/TD]
[TD]Tony
[/TD]
[TD]Andy
[/TD]
[TD]John
[/TD]
[TD]Jo
[/TD]
[TD]Kevin
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]INV NO
[/TD]
[TD]PRODUCT
[/TD]
[TD]TYPE
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]1234
[/TD]
[TD]Glue
[/TD]
[TD]sticky
[/TD]
[TD]40
[/TD]
[TD][/TD]
[TD][/TD]
[TD]20
[/TD]
[TD][/TD]
[TD][/TD]
[TD]12
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]1235
[/TD]
[TD]Jam
[/TD]
[TD]Strawb
[/TD]
[TD][/TD]
[TD]12
[/TD]
[TD][/TD]
[TD]12
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]1236
[/TD]
[TD]Maps
[/TD]
[TD]Euro
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]60
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]1121
[/TD]
[TD]Glue
[/TD]
[TD]Dry
[/TD]
[TD][/TD]
[TD][/TD]
[TD]34
[/TD]
[TD][/TD]
[TD][/TD]
[TD]45
[/TD]
[TD][/TD]
[TD]11
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]1000
[/TD]
[TD]Sand
[/TD]
[TD]Paper
[/TD]
[TD][/TD]
[TD][/TD]
[TD]12
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


















So as you can see, I currently have all my sales in one row for each product, but I need to change this to a list like shown below.
Also its important to note that not every row has sales as Columns A, B & C are a List of Every product we Sell so some will have no sales and some clould have everyone selling as shown above.

What I want it to look like

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD][/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]INV NO
[/TD]
[TD]PRODUCT
[/TD]
[TD]TYPE
[/TD]
[TD]Sales Person
[/TD]
[TD]Amount
[/TD]
[TD]Date
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]1234
[/TD]
[TD]Glue
[/TD]
[TD]sticky
[/TD]
[TD]Terry
[/TD]
[TD]40
[/TD]
[TD]12/06/2017
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]1234
[/TD]
[TD]Glue
[/TD]
[TD]Sticky
[/TD]
[TD]Tony
[/TD]
[TD]20
[/TD]
[TD]12/06/17
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]1234
[/TD]
[TD]Glue
[/TD]
[TD]Sticky
[/TD]
[TD]JO
[/TD]
[TD]12
[/TD]
[TD]12/06/17
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]1235
[/TD]
[TD]Jam
[/TD]
[TD]Strawb
[/TD]
[TD]Sue
[/TD]
[TD]12
[/TD]
[TD]12/06/17
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]1235
[/TD]
[TD]Jam
[/TD]
[TD]Strawb
[/TD]
[TD]Tony
[/TD]
[TD]12
[/TD]
[TD]12/06/17
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD]1236
[/TD]
[TD]Maps
[/TD]
[TD]Euro
[/TD]
[TD]Andy
[/TD]
[TD]60
[/TD]
[TD]12/06/17
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9
[/TD]
[TD]1121
[/TD]
[TD]Glue
[/TD]
[TD]Dry
[/TD]
[TD]Mat
[/TD]
[TD]34
[/TD]
[TD]12/06/17
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10
[/TD]
[TD]1121
[/TD]
[TD]Glue
[/TD]
[TD]Dry
[/TD]
[TD]John
[/TD]
[TD]45
[/TD]
[TD]12/06/17
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11
[/TD]
[TD]1121
[/TD]
[TD]Glue
[/TD]
[TD]Dry
[/TD]
[TD]Kevin
[/TD]
[TD]11
[/TD]
[TD]12/06/17
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]12
[/TD]
[TD]1000
[/TD]
[TD]Sand
[/TD]
[TD]Paper
[/TD]
[TD]Mat
[/TD]
[TD]12[/TD]
[TD]12/06/17
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]























I'm really stuck with this one so please help if you can

Thanks

Tony
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
Try this from sheet "Data" to sheet "New Data".
Code: 
[COLOR="Navy"]Sub[/COLOR] MG06Jul23
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nRay
Ray = Sheets("Data").Cells(1).CurrentRegion
c = 1
ReDim nRay(1 To 6, 1 To 1)
nRay(1, 1) = "INV NO": nRay(2, 1) = "PRODUCT": nRay(3, 1) = "TYPE"
nRay(4, 1) = "Sales Person": nRay(5, 1) = "Amount": nRay(6, 1) = "Date"
[COLOR="Navy"]For[/COLOR] n = 3 To UBound(Ray, 1)
 [COLOR="Navy"]For[/COLOR] Ac = 4 To UBound(Ray, 2)
   [COLOR="Navy"]If[/COLOR] Not IsEmpty(Ray(n, Ac)) [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        ReDim Preserve nRay(1 To 6, 1 To c)
        nRay(1, c) = Ray(n, 1)
        nRay(2, c) = Ray(n, 2)
        nRay(3, c) = Ray(n, 3)
        nRay(4, c) = Ray(1, Ac)
        nRay(5, c) = Ray(n, Ac)
        nRay(6, c) = CDbl(DateValue(Ray(1, 2)))
    [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] Sheets("New Data").Range("A1").Resize(c, 6)
   .Columns("F:F").NumberFormat = "dd/mm/yyyy"
   .Value = Application.Transpose(nRay)
   .Columns.AutoFit
   .Borders.Weight = 2
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
This is based on the data you posted. Here's my Sheet:


Book1
ABCDEFGHIJK
1DATE12/06/2017SALES PERSONTerrySueMatTonyAndyJohnJoKevin
2INV NOPRODUCTTYPE
31234Gluesticky402012
41235JamStrawb1212
51236MapsEuro60
61121GlueDry344511
71000SandPaper12
Sheet1


This is the code I used:

Code: 
Public Sub GridToList()

Dim gridSheet As Worksheet
Dim listSheet As Worksheet
Dim lastRow As Long
Dim thisRow As Long
Dim lastCol As Long
Dim thisCol As Long
Dim nextRow As Long

' Assume current sheet is the sheet with the grid
Set gridSheet = ActiveSheet

' Add a new sheet for the list
Set listSheet = Sheets.Add

' Set up header row on new sheet
listSheet.Cells(1, 1).Value = gridSheet.Cells(2, 1).Value
listSheet.Cells(1, 2).Value = gridSheet.Cells(2, 2).Value
listSheet.Cells(1, 3).Value = gridSheet.Cells(2, 3).Value
listSheet.Cells(1, 4).Value = gridSheet.Cells(1, 3).Value
listSheet.Cells(1, 5).Value = "AMOUNT"
listSheet.Cells(1, 6).Value = gridSheet.Cells(1, 1).Value

' Start at row 2 on new sheet
nextRow = 2

' Find last row as column on the grid sheet
With gridSheet
    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
End With

' Process all rows
For thisRow = 3 To lastRow
    ' Process all columns
    For thisCol = 4 To lastCol
        ' Sale?
        If gridSheet.Cells(thisRow, thisCol).Value <> "" Then
            listSheet.Cells(nextRow, 1).Value = gridSheet.Cells(thisRow, 1).Value
            listSheet.Cells(nextRow, 2).Value = gridSheet.Cells(thisRow, 2).Value
            listSheet.Cells(nextRow, 3).Value = gridSheet.Cells(thisRow, 3).Value
            listSheet.Cells(nextRow, 4).Value = gridSheet.Cells(1, thisCol).Value
            listSheet.Cells(nextRow, 5).Value = gridSheet.Cells(thisRow, thisCol).Value
            listSheet.Cells(nextRow, 6).Value = gridSheet.Cells(1, 2).Value
            nextRow = nextRow + 1
        End If
    Next thisCol
Next thisRow

End Sub

Which gave me this:


Book1
ABCDEF
1INV NOPRODUCTTYPESALES PERSONAMOUNTDATE
21234GluestickyTerry4012/06/2017
31234GluestickyTony2012/06/2017
41234GluestickyJo1212/06/2017
51235JamStrawbSue1212/06/2017
61235JamStrawbTony1212/06/2017
71236MapsEuroAndy6012/06/2017
81121GlueDryMat3412/06/2017
91121GlueDryJohn4512/06/2017
101121GlueDryKevin1112/06/2017
111000SandPaperMat1212/06/2017
Sheet2


WBD
 
Upvote 0
Thanks MickG & WideBoy,
Both codes worked great so thank you,

Another problem solved :-)

Tony
 
Upvote 0
tonywatsonhelp,

Here is another macro solution for you to consider, that uses two arrays in memory, and, will adjust to the number of raw data rows, and, columns.

I assume that both worksheets exist.

Samle raw data worksheets:


Excel 2007
ABCDEFGHIJKL
1DATE12/6/2017SALES PERSONTerrySueMatTonyAndyJohnJoKevin
2INV NOPRODUCTTYPE
31234Gluesticky402012
41235JamStrawb1212
51236MapsEuro60
61121GlueDry344511
71000SandPaper12
8
Data



Excel 2007
ABCDEFG
1
2INV NOPRODUCTTYPESales PersonAmountDate
3
4
5
6
7
8
9
10
11
12
13
New Data


And, after the macro:


Excel 2007
ABCDEFG
1
2INV NOPRODUCTTYPESales PersonAmountDate
31234GluestickyTerry4012/6/2017
41234GluestickyTony2012/6/2017
51234GluestickyJo1212/6/2017
61235JamStrawbSue1212/6/2017
71235JamStrawbTony1212/6/2017
81236MapsEuroAndy6012/6/2017
91121GlueDryMat3412/6/2017
101121GlueDryJohn4512/6/2017
111121GlueDryKevin1112/6/2017
121000SandPaperMat1212/6/2017
13
New Data




Code: 
Sub ReorganizeData()
' hiker95, 07/06/2017, ME1012935
Application.ScreenUpdating = False
Dim wd As Worksheet, wnd As Worksheet
Dim a As Variant, lr As Long, lc As Long, i As Long, c As Long, n As Long
Dim o As Variant, j As Long
Set wd = Sheets("Data")
Set wnd = Sheets("New Data")
With wd
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, Columns.Count).End(xlToLeft).Column
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  n = Application.Count(.Range(.Cells(3, 4), .Cells(lr, lc)))
  ReDim o(1 To n, 1 To 6)
End With
For i = 3 To lr
  For c = 4 To lc
    If Not a(i, c) = vbEmpty Then
      j = j + 1: o(j, 1) = a(i, 1): o(j, 2) = a(i, 2): o(j, 3) = a(i, 3)
      o(j, 4) = a(1, c): o(j, 5) = a(i, c): o(j, 6) = a(1, 2)
    End If
  Next c
Next i
With wnd
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  If lr > 2 Then
    .Range(.Cells(3, 1), .Cells(lr, 6)).ClearContents
  End If
  .Cells(3, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns.AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Turning Chronological List into a Table like report
Replies
0
Views
368
jconkl02
J
J
  • Question Question
Excel macro for Remove comma's and spaces from a cell and place the data in different cell
Replies
3
Views
1K
JEC
JEC
davewatson86
  • Question Question
Top 50 List using Formulas
Replies
5
Views
845
Eric W
Eric W
T
  • Question Question
Macro to fill in my caledar sheet with my dates adding extra rows when we get duplicates apointments
Replies
0
Views
650
tonywatsonhelp
T
T
  • Question Question
Macro to take data from a grid and add it to my calender under that persons name?
Replies
1
Views
509
dhamstad
D

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top