What should be the VBA code for this output

[sanmaya]

Hi All,

I need the VBA code for the Output which is in the output tab of the sample file for my input data. i hope that someone from this forum can help me with the CODE.

Please refer the Attached Sample file for your reference.


Thanks in Advance.

[Bob Phillips]

Public Sub Reformat
Dim this As Worksheet
Dim ws As Worksheet
Dim lastrow As Long
Dim nextrow As Long
Dim matchrow As Long
Dim i As Long

    Set this = ActiveSheet
    Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    With ws
    
        .Range("B1").Value = "Year"
        .Range("A2:N2").Value = Array("Products", "Month", 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
        .Range("C1").Value = "2014"
        .Range("C1:N1").HorizontalAlignment = xlCenterAcrossSelection
        
        .Columns("B:B").ColumnWidth = 5.29
        .Columns("C:N").ColumnWidth = 4
        .Range("B1:N2").Font.Bold = True
        With .Range("A2:N2").Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorLight2
            .TintAndShade = 0.799981688894314
            .PatternTintAndShade = 0
        End With
        With .Range("C1:N1").Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.499984740745262
            .PatternTintAndShade = 0
        End With
        .Range("A3").Interior.ColorIndex = 6
    End With
    
    With this
    
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        nextrow = 2
        For i = 2 To lastrow
        
            matchrow = 0
            On Error Resume Next
            matchrow = Application.Match(.Cells(i, "A").Value, ws.Columns(1), 0)
            On Error GoTo 0
            If matchrow = 0 Then
                nextrow = nextrow + 1
                matchrow = nextrow
                ws.Cells(matchrow, "A").Value = .Cells(i, "A").Value
            End If
            ws.Cells(matchrow, Month(.Cells(i, "B").Value) + 2).Value = .Cells(i, "C").Value
        Next i
    End With
    
    ws.Range("A3").Copy
    ws.Range("A4").Resize(nextrow - 3).PasteSpecial Paste:=xlPasteFormats
    
    Application.CutCopyMode = False
End Sub

[sanmaya]

Hi xld,

Thanks for the code. but to need to clarify that no need to create the output template , it is already exist. and my apology that i could not explain clearly my requirement.

here is the clear description of my requirement if you can help me.

i need to display four years data that, previous year, current year, and next two year from current year, please check the output template in the sample file.

i need the code to insert the input qty data to the cells corresponds to the year and months cell of the respective product.

Please help me with the code.