Results 1 to 7 of 7

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

  1. #1

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



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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
    Attached Files Attached Files

  2. #2
    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

  3. #3
    Hi Bob,

    Thanks for the solution.

    Great Job...

    Regards
    Kumar

  4. #4
    Hi Bob,

    How can i make this thread as "Solved".

    I am unable to find it.


    Regards
    Kumar

  5. #5
    It should be in the 'Thread Tools' dropdown, but I know some forums have a problem if using Chrome.

  6. #6
    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

  7. #7
    HAve you looked under the Administrative dropdown Kumar, do you have such a dropdown? If not, I can close it for you.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •