VBA Program to create a required data table structure from the available data?

ravikumar00008

New member
Joined
Jun 13, 2012
Messages
20
Reaction score
0
Points
0
Hi All,

Please look at the attachment of a sample workbook.

I have an workbook contains different worksheets having the data.

Finally i need to prepare a summarized resultant table from those sheets in a separate existed sheet(ex:"Finalresult" sheet) in the attached workbook.

Right now i have prepared manually(You can see the "FinalResult" sheet,this is the structure i want).

Please let me know any solution to achieve this kind of thing in VBA.

Thanks in advance.

Ragards
Kumar
 

Attachments

  • SampleTest.xlsx
    18.4 KB · Views: 97

Bob Phillips

Super Moderator
Staff member
Joined
Mar 21, 2011
Messages
1,940
Reaction score
0
Points
36
Excel Version(s)
O365
Code:
Public Sub ProcessData()Dim ws As Worksheet
Dim lastrow As Long
Dim nextrow As Long
Dim i As Long


    Application.DisplayAlerts = False
    On Error Resume Next
    Worksheets("FinalResult").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = False
    
    Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    With ws.Range("A4:H4")
    
        .Value = Array("Location", "GEN", "Mach", "Month", "Prod_ID", "Shift", "LP", "Prod")
        .Font.Bold = True
    End With
    
    nextrow = 5
    With Worksheets("Input")
    
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 5 To lastrow
        
            ws.Cells(nextrow, "A").Resize(12).Value = .Cells(i, "A").Value
            ws.Cells(nextrow, "B").Resize(12).Value = .Cells(i, "B").Value
            ws.Cells(nextrow, "C").Resize(12).Value = .Cells(i, "C").Value
            ws.Cells(nextrow, "D").Resize(12).Value = Application.Transpose(.Range("D4:O4"))
            nextrow = nextrow + 12
        Next i
        
        Call AddFormula(ws.Range("E5"), "Input", nextrow - 5)
        Call AddFormula(ws.Range("F5"), "Shift", nextrow - 5)
        Call AddFormula(ws.Range("G5"), "LP", nextrow - 5)
        Call AddFormula(ws.Range("H5"), "Prod", nextrow - 5)
        
        ws.Columns("D").NumberFormat = "mmm-yy"
        ws.Name = "FinalResult"
    End With
    
    Application.ScreenUpdating = True
End Sub


Private Sub AddFormula(ByRef startat As Range, sheetname As String, ByVal numrows As Long)
Const FORMULA_LOOKUP As String = _
    "=INDEX(<sheet>!$A$4:$O$<lastrow>," & _
    "MATCH(1,($A5=<sheet>!$A$4:$A$<lastrow>)*($B5=<sheet>!$B$4:$B$<lastrow>)*($C5=<sheet>!$C$4:$C$<lastrow>),0)," & _
    "MATCH($D5,<sheet>!$A$4:$O$4,0))"
Dim lastrow As Long


    lastrow = Worksheets(sheetname).Cells(startat.Parent.Rows.Count, "A").End(xlUp).Row
    startat.FormulaArray = Replace(Replace(FORMULA_LOOKUP, _
                                                        "<lastrow>", lastrow), _
                                                "<sheet>", sheetname)
    startat.AutoFill startat.Resize(numrows)
End Sub
 

ravikumar00008

New member
Joined
Jun 13, 2012
Messages
20
Reaction score
0
Points
0
Hi Bob,

How can i make this thread as "Solved".

I am unable to find it.


Regards
Kumar
 

Bob Phillips

Super Moderator
Staff member
Joined
Mar 21, 2011
Messages
1,940
Reaction score
0
Points
36
Excel Version(s)
O365
It should be in the 'Thread Tools' dropdown, but I know some forums have a problem if using Chrome.
 

ravikumar00008

New member
Joined
Jun 13, 2012
Messages
20
Reaction score
0
Points
0
I didn't find it in "Firefox" and "IE9" also.

Is it possible to make this thread as solved from "Admin" side.
If possible i have no problem.

Regards
Kumar
 

Bob Phillips

Super Moderator
Staff member
Joined
Mar 21, 2011
Messages
1,940
Reaction score
0
Points
36
Excel Version(s)
O365
HAve you looked under the Administrative dropdown Kumar, do you have such a dropdown? If not, I can close it for you.
 
Top