VBA--> Make array into rows with unique values

[cpeck0321]

Hello! I'm trying to use VBA to accomplish something, but I am not formally trained in VBA so I am struggling. I am trying to accomplish something like this

Does anyone know a similar thread that I could reference or could help with what I'm trying to do? Thanks!

 

[smozgur]

Welcome to the MrExcel Message Board!

Name the input range as "data" (range starting from the empty top-left cell), and follow the comments in the codes below.

First sample code, simply looping through the company columns and fruit rows:

Sub doItMethod1()
Dim rng As Range
Dim cll As Range
Dim cllFruit As Range
Dim rngCompany As Range
Dim rngFruit As Range
Dim rngOutput As Range

    ' Input range
    Set rng = ActiveSheet.Range("data")
    ' Output range top left cell
    ' Start one row below the input range
    Set rngOutput = rng.Offset(rng.Rows.Count + 1).Resize(1, 1)
   
    ' Company columns range
    ' We are going to loop through companies
    ' to create the desired table
    ' Relative to the whole data, rng,
    ' it starts after 2 columns (offset 2 columns)
    ' and 2 columns less than the entire data column length (resize -2 columns)
    Set rngCompany = rng.Offset(, 2).Resize(, rng.Columns.Count - 2)
   
    ' Fruit ID range - similar to Company columns, but rows this time
    Set rngFruit = rng.Offset(1).Resize(rng.Rows.Count - 1)
   
    ' Loop through company name cells - the first row of the company range
    For Each cll In rngCompany.Rows(1).Cells
        ' Loop through fruit id cells
        ' and fill the output table with corresponding data
        For Each cllFruit In rngFruit.Columns(1).Cells
            With rngOutput
                .Value = cll.Value
                .Offset(, 1).Value = cllFruit.Cells(, 1).Value
                .Offset(, 2).Value = cllFruit.Cells(, 2).Value
                .Offset(, 3).Value = cllFruit.Cells(, cll.Column - cllFruit.Column + 1).Value
            End With
            ' Jump to the next row
            Set rngOutput = rngOutput.Offset(1)
        Next cllFruit
    Next cll
End Sub

The previous code is just to demonstrate using Offset and Resize VBA functions to pick data columns and rows from a range, and some calculation.

However, if we look at your desired output, it is something like this: Copy each company data column with corresponding fruits and also add the company name as the first column. So, we can see how the Union and Copy VBA functions could help in this case.
Follow the comments.

Sub doItMethod2()
Dim rng As Range
Dim cll As Range
Dim cllFruit As Range
Dim rngCompany As Range
Dim rngFruit As Range
Dim rngOutput As Range
Dim rngCompanyData As Range

    ' Input range
    Set rng = ActiveSheet.Range("data")
    ' Output range top left cell
    ' Start one row below the input range
    Set rngOutput = rng.Offset(rng.Rows.Count + 1).Resize(1, 1)
   
    ' Company columns range
    ' We are going to loop through company columns
    ' to create the desired table
    ' Relative to the whole data, rng,
    ' it starts after 2 columns (offset 2 columns)
    ' and 2 columns less than the entire data column length (resize -2 columns)
    Set rngCompany = rng.Offset(, 2).Resize(, rng.Columns.Count - 2)
   
    ' Fruit ID range - similar to Company columns, but rows this time
    ' We need only two columns with fruit id and name
    Set rngFruit = rng.Offset(1).Resize(rng.Rows.Count - 1, 2)

   
    ' Loop through company columns
    For Each cll In rngCompany.Columns
        ' Create a new range with fruit columns and company column
        Set rngCompanyData = Union(rngFruit, cll.Offset(1).Resize(cll.Rows.Count - 1))
        ' Copy this new range to the output range
        rngCompanyData.Copy rngOutput.Offset(, 1).Resize(rngCompanyData.Rows.Count, rngCompanyData.Columns.Count)
        ' Also copy the associated company name
        cll.Cells(1).Copy rngOutput.Resize(rngCompanyData.Rows.Count)
        ' Set the new output row
        Set rngOutput = rngOutput.Offset(rngCompanyData.Rows.Count)
    Next cll
End Sub

This is how I would do it in VBA. There are surely many different ways to do the same thing by using VBA, even quicker ways, and even VBA-less ways by using Power Query.

 

[Dossfm0q]

Good Morning

Formula Option

Book1
	A	B	C	D	E
2			Company 1	Company 2	Company 3
3	100000	Apples	5	6	4
4	120000	Bannans	3	7	4
5	130000	Oranges	2	3	4
6	140000	Pineappls	4	7	9
7	150000	Grapes	8	6	10
8
9
10
11
12
13	Company 1	Apples	5	6	4
14	Company 1	Bannans	3	7	4
15	Company 1	Oranges	2	3	4
16	Company 1	Pineappls	4	7	9
17	Company 1	Grapes	8	6	10
18	Company 2	Apples	5	6	4
19	Company 2	Bannans	3	7	4
20	Company 2	Oranges	2	3	4
21	Company 2	Pineappls	4	7	9
22	Company 2	Grapes	8	6	10
23	Company 3	Apples	5	6	4
24	Company 3	Bannans	3	7	4
25	Company 3	Oranges	2	3	4
26	Company 3	Pineappls	4	7	9
27	Company 3	Grapes	8	6	10
Sheet1

Cell Formulas
Range	Formula
A13:A27	A13	=INDEX($C$2:$K$2,,AGGREGATE(15,6,(COLUMN($C$2:$K$2)-COLUMN($C$2)+1)*CEILING(ROWS($A$3:A3)/COUNTA($A$3:$A$7)/--($C$2:$K$2<>""),1),1))
B13:E27	B13	=IF(AND($A13<>"",$A13<>0),INDEX(B$3:B$7,AGGREGATE(15,6,(ROW(B$3:B$7)-ROW(B$3)+1)*(MOD(ROWS($A$3:A3)-1,COUNTA($A$3:$A$7))+1),1)),"")

 

[cpeck0321]

Thank you so much smozgur! This is exactly what I was looking for and was spinning my wheels way too much. I'm working with standardized reports so this will work perfect.

 

[smozgur]

Thank you so much smozgur! This is exactly what I was looking for and was spinning my wheels way too much. I'm working with standardized reports so this will work perfect.

Glad to hear it helps!