How to continue the loop through each cell of Next Row?

0
votes

As seen below, I have 3 sheets, viz: Sheet "Shops-Fruits Data", Sheet ("Months"), and Sheet ("Output").

I am trying to copy the data from Sheet "Shops-Fruits Data" based on months from Sheet ("Months") to ("Output") structure. I have written a code. However, with this code I can only iterate through first row. I don't understand, how do I continue to the next row till the last row. Second, I also can't copy the Shops and fruits name to the Sheet ("Output").

I have manually copied the desired result in Sheet Output table as seen below, there you can see what I want to achieve. It would be great if anyone can lead me! Thank you.

Sheets("Shops-Fruits Data")

A B C D E F G H I J K L M N O
1 2021 2021 2021 2021 2021 2021 2021 2021 2021 2021 2021 2021
2 Shop Fruits Quantity JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC
3 Walmart Apple Quantity 10 20 30 40 50 60 70 80 90 10 11 12
4 Walmart Orange Quantity 12 13 14 15 16 17 18 19 20 21 22 23
5 D-Mart Apple Quantity 36 38 40 42 44 46 48 50 52 54 56 58

Sheets ("Months")

A
1 JAN
2 FEB
3 MAR
4 APR
5 MAY
6 JUN
7 JUL
8 AUG
9 SEP
10 OCT
11 NOV
12 DEC

Sheets ("Output")

Shop Fruits Year Month Quantity
Walmart Apple 2021 JAN 10
Walmart Apple 2021 FEB 20
Walmart Apple 2021 MAR 30
Walmart Apple 2021 APR 40
Walmart Apple 2021 MAY 50
Walmart Apple 2021 JUN 60
Walmart Apple 2021 JUL 70
Walmart Apple 2021 AUG 80
Walmart Apple 2021 SEP 90
Walmart Apple 2021 OCT 10
Walmart Apple 2021 NOV 11
Walmart Apple 2021 DEC 12
Walmart Orange 2021 JAN 12
Walmart Orange 2021 FEB 13
Walmart Orange 2021 MAR 14
Walmart Orange 2021 APR 15
Walmart Orange 2021 MAY 16
Walmart Orange 2021 JUN 17
Walmart Orange 2021 JUL 18
Walmart Orange 2021 AUG 19
Walmart Orange 2021 SEP 20
Walmart Orange 2021 OCT 21
Walmart Orange 2021 NOV 22
Walmart Orange 2021 DEC 23
D-Mart Apple 2021 JAN 36
D-Mart Apple 2021 FEB 38
D-Mart Apple 2021 MAR 40
D-Mart Apple 2021 APR 42
D-Mart Apple 2021 MAY 44
D-Mart Apple 2021 JUN 46
D-Mart Apple 2021 JUL 48
D-Mart Apple 2021 AUG 50
D-Mart Apple 2021 SEP 52
D-Mart Apple 2021 OCT 54
D-Mart Apple 2021 NOV 56
D-Mart Apple 2021 DEC 58

The code I am trying:

Sub test()

Dim c As Range, d As Range, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, LastRow As Long
Dim Mon As String


Set ws1 = Sheets("Shops-Fruits Data")
Set ws2 = Sheets("Months")
Set ws3 = Sheets("Output")

LastRow = ws2.Cells(Rows.Count, 1).End(xlUp).Row
i = 2
For Each c In ws2.Range("A1:A" & LastRow)
    Mon = c.Value

    With ws1.Range("D2:O2")
        Set d = .Find(Mon, , LookIn:=xlValues)
    With ws3.Range("D:D")
          'Copy Months
          .Cells(i, 1) = c.Value
          'Copy Year
          .Cells(i, 0) = d.Offset(-1, 0).Value
          'Copy Quantity
          .Cells(i, 2) = d.Offset(1, 0).Value
          'Copy Fruit Name till December.
          .Cells(2, -1) = d.Offset(1, -1).Value 'But it fails!
          'Copy Shop Name till December.
          .Cells(2, -2) = d.Offset(1, -2).Value 'But it fails!
            i = i + 1
           'How do I continue to next row now?
    End With
    End With
    Next c
End Sub
2
excelvba
It's not clear what the purpose of the Months" sheet is. Your output look like a straight "depivot" of "Shops-Fruits Data" – Tim Williams
@Tim Williams The purpose of Months" Sheet is just to find the respective months data from the Shops-Fruits Data sheet – Goku
The month is there on your data sheet though? – Tim Williams
@Tim Williams Nah, I created it just to search Months in Sheet "Shops-Fruits Data" . But, I think you have a valid point, I looked it at twice and it looks like a "Unpivot" of Sheet "Shops-Fruits Data" . Then , I recorded a macro and I got what I want ! Only the year I will past manually! Thanks for the tip though! Best Regards! :) – Goku

2 Answers

0
votes

As per the point placed by Tim Williams, here is the code for unpivoting the data.

Sub test()
    
    
        Sheets("Shops-Fruits Data").Range("Table10").Select
        ActiveWorkbook.Queries.Add Name:="Query", Formula:= _
            "let" & Chr(13) & "" & Chr(10) & "    Source = Excel.CurrentWorkbook(){[Name=""Table10""]}[Content]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Source,{{""Shop"", type text}, {""Fruits"", type text}, {""Quantity"", type text}, {""JAN"", Int64.Type}, {""FEB"", Int64.Type}, {""MAR"", Int64.Type}, {""APR"", Int64.Type}, {""MAY"", Int64.Type}, {""JUN"", Int64.Type}, {""JUL"", Int64.Type}, " & _
            "{""AUG"", Int64.Type}, {""SEP"", Int64.Type}, {""OCT"", Int64.Type}, {""NOV"", Int64.Type}, {""DEC"", Int64.Type}})," & Chr(13) & "" & Chr(10) & "    #""Unpivoted Other Columns"" = Table.UnpivotOtherColumns(#""Changed Type"", {""Shop"", ""Fruits"", ""Quantity""}, ""Attribute"", ""Value"")" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Unpivoted Other Columns"""
    
        With Sheets("Output").ListObjects.Add(SourceType:=0, Source:= _
            "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Query"";Extended Properties=""""" _
            , Destination:=Sheets("Output").Range("$A$1")).QueryTable
            .CommandType = xlCmdSql
            .CommandText = Array("SELECT * FROM [Query]")
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = True
            .ListObject.DisplayName = "Table_10"
            .Refresh BackgroundQuery:=False
        End With
        Range("F2").Select
    End Sub
0
votes

Here's a basic depivot:

Sub Depivot()
    
    Dim arr, arrOut, r As Long, c As Long, rOut As Long
    
    arr = Worksheets("Data").Range("a1").CurrentRegion.Value   'input data to array
    ReDim arrOut(1 To UBound(arr, 1) * UBound(arr, 2), 1 To 5) 'resize output array (approx. size)
    'loop input array
    For r = 3 To UBound(arr, 1)
        For c = 4 To UBound(arr, 2)
            rOut = rOut + 1
            arrOut(rOut, 1) = arr(r, 1)
            arrOut(rOut, 2) = arr(r, 2)
            arrOut(rOut, 3) = arr(1, c)
            arrOut(rOut, 4) = arr(2, c)
            arrOut(rOut, 5) = arr(r, c)
        Next c
    Next r
    'place the output on a sheet
    Worksheets("Depivot").Range("A1").Resize(rOut, 5).Value = arrOut

End Sub