Consulting

Results 1 to 2 of 2

Thread: consolidate data from multiple excel files into single file

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    VBAX Newbie
    Joined
    Aug 2013
    Posts
    1
    Location

    consolidate data from multiple excel files into single file

    Dear Friends,

    Can someone help me with below? How can I modify below code to consolidate 8 data files into 1 file using a similar setup as "SplitRpt" .
    Please help me in this context since I am incompetent in VBA programming.

    Private Sub SplitRptByPackage()
        Dim fXLSFile As String
        'Dim nRow As Integer
        Dim iRow As Integer
        Dim custcode As String
        Dim colvalue As String
        Dim coltitle As String
        Dim site_cnt As Integer
        Dim site_name As String
        Dim colDest As String
        Dim ext_rpt As Worksheet
        Dim wip_rpt As Worksheet
        Dim CustWIP As String, tCustWIP As String
        ' Loop for 2 sites
        For site_cnt = SiteStart To SiteCount
            If site_cnt = 1 Then
                site_name = "M"
                webwipext_txt = WEBWIPEXT_TXT_M
                If Not fMOK Then GoTo skipNextSite
            Else
                site_name = "S"
                webwipext_txt = WEBWIPEXT_TXT_S
                If Not fSOK Then GoTo skipNextSite
            End If
            ' WIP report name
            If vTestRun Then
                fXLSFile = site_name & pfName & "_" & TestRunSession & ".xls"
            Else
                fXLSFile = site_name & pfName & ".xls"
            End If
            
            ' Workplace worksheet
            Worksheets("SplitRpt").Select
            Set ext_rpt = ActiveWorkbook.ActiveSheet
            
            ' Get the Split info customer list start row
            iRow = 2
            nVal1 = 0
            ' Loop until end of the list
            Do Until ext_rpt.Cells(iRow, 1) = ""
                ' Get setup info from SplitRpt worksheet
                custcode = ext_rpt.Cells(iRow, 1)
                coltitle = ext_rpt.Cells(iRow, 2)
                colvalue = ext_rpt.Cells(iRow, 3)
                colFilename = ext_rpt.Cells(iRow, 4)
                nVal1 = InStr(1, colvalue, ",")
                If nVal1 > 0 Then
                   colPkg = Mid(colvalue, 1, nVal - 1)
                Else
                   colPkg = Trim(colvalue)
                End If
                ' Skip other customer code if not in cust list (manual run only)
                If manual_by_cust <> "" And InStr(manual_by_cust, custcode) = 0 Then GoTo skipNextCust
                
                ' Open Customer WIP which need to split if exist otherwise skip to next customer
                CustWIP = FDIR & custcode & "\" & fXLSFile
                If Not FileExists(CustWIP) Then GoTo skipNextCust
                Debug.Print "UpdExtInfo:: " & custcode & " for " & site_name & "-Site"
                ' Open customer WIP
                Workbooks.Open filename:=CustWIP
                ' WIP worksheet
                Set wip_rpt = ActiveWorkbook.ActiveSheet
                
                colDest = "*" & colPkg & "*"
                If findColumn(colDest, wip_rpt) > 0 Then
                   Application.DisplayAlerts = False
                   SaveFileName = site_name & pfName & colFilename & ".xls"
                   SaveAsFileName = FDIR & custcode & "\" & SaveFileName
                   ActiveWorkbook.SaveAs filename:=SaveAsFileName, FileFormat:=xlExcel5, _
                      Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
                      
                   Windows(SaveFileName).Activate
                   Set cust_rpt = ActiveWorkbook.ActiveSheet
                    
                   '-- Loop to remove unwanted pacakge
                   l_cnt = 11
                   Do Until cust_rpt.Cells(l_cnt, 1) = "DEFINITIONS OF TERMS:"
                      If (cust_rpt.Cells(l_cnt, 3) Like colDest) Or _
                         (cust_rpt.Cells(l_cnt, 3) = "") Or _
                         (cust_rpt.Cells(l_cnt, 3) = "Grand Total") Then
                         Cells(l_cnt, 30) = ""
                      Else
                         If (cust_rpt.Cells(l_cnt, 3) = "TBA") Then
                           nVal1 = 0
                           nVal1 = InStr(1, cust_rpt.Cells(l_cnt, 4), "-" & colPkg)
                           If nVal1 > 0 Then
                              Cells(l_cnt, 30) = ""
                           Else
                             nVal1 = 0
                             nVal2 = 0
                             nVal1 = InStr(1, cust_rpt.Cells(l_cnt, 4), "-SC70")
                             nVal2 = InStr(1, cust_rpt.Cells(l_cnt, 4), "-SOT")
                             If (nVal1 = 0 And nVal2 = 0) And colPkg = "SC70" Then
                                Cells(l_cnt, 30) = ""
                             Else
                                Cells(l_cnt, 30) = "DEL"
                             End If
                           End If
                         Else
                           If (cust_rpt.Cells(l_cnt, 3) = "TBA Total") Then
                              Cells(l_cnt, 30) = ""
                           Else
                              Cells(l_cnt, 30) = "DEL"
                           End If
                         End If
                      End If
                      l_cnt = l_cnt + 1
                   Loop
                   
                   '-- Perform deletion
                   l_cnt = 11
                   Do Until cust_rpt.Cells(l_cnt, 1) = "DEFINITIONS OF TERMS:"
                      If cust_rpt.Cells(l_cnt, 30) = "DEL" Then
                         vAdd = l_cnt & ":" & l_cnt
                         Rows(vAdd).Select
                         Selection.Delete Shift:=xlUp
                         l_cnt = l_cnt - 1
                      End If
                      l_cnt = l_cnt + 1
                   Loop
                   
                   'Close the wip repot
                   cust_rpt.Select
                   ActiveWorkbook.Save
                   ActiveWorkbook.Close
                Else
                   ActiveWorkbook.Close
                End If
    skipNextCust:
                iRow = iRow + 1
            Loop
    skipNextSite:
        Next site_cnt
    End Sub
    **************************
    "SplitRpt" Sheet Content

    CUST SPLIT BY VALUE APPEND_FILENAME REMARK
    AVG PKG SC70 _SC70
    AVG PKG SOT _SOT

    Suggesting setup as below :
    Every cust has one folder each with its own data. Need to consolidate all 8 cust excel sheet into 1 sheet by maintaining the existing folders and data for each cust. Which means every cust folder will still have separate cust data but under each folder will also have an additional sheet of the consolidated version.How can I modify the above code to achieve this?

    CUST APPEND_FILENAME
    SGC _ST
    SGG _ST
    SGF _ST
    SGS _ST
    SGT _ST
    SGE _ST
    SGU _ST
    SGR _ST

    Thank you in advance.

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    hkk,

    Welcome to the forum, I hope we give you more help than you expect. Sometimes we get so busy that a new thread "falls off" the first index page, but someone will always go through the older pages looking for un-answered threads like yours. In the future, If you don't see your thread on the main index page, AND, it has been more than 24 hours since you posted it last, you are allowed to make a "bumping" post to it. A personal reply to your own post that simply says "Please" will be enough to put it back on the main index page.

    Every cust has one folder each with its own data. Need to consolidate all 8 cust excel sheet into 1 sheet by maintaining the existing folders and data for each cust. Which means every cust folder will still have separate cust data but under each folder will also have an additional sheet of the consolidated version.How can I modify the above code to achieve this?
    By "sheet," I assume that you really mean Workbook. A Workbook can contain many Sheets. A Sheet is sometimes called a "Tab" in a Workbook. Technically a Sheet can be a Worksheet or a Chart (sheet,) but unless otherwise specified, we all use "Sheet" to just mean "Worksheet."

    For now, we'll ignore the code you posted because it is not doing the job for you. We may come back to it later.


    ___________________________________________________________________________ _____________
    In order to code for the job, we need to know exactly what the job is because code only does exactly what it is "told."

    You have many customer folders. We'll need to know the path to the folder that contains all the customer folders. Each Customer Folder contains many xl files (8 ATT) that you want to extract data from. We will also need to know the Naming Pattern for the Customer folders.

    We will need to know how the data is laid out in a sample workbook. We need to see how you want the data laid out in the consolidation Workbook. We also need to know the Naming Pattern for the Customer Workbooks.

    Please prepare a sample Workbook one Worksheet, Tab named "Result" showing how you want the consolidated data laid out and copies of all Customer Worksheets that data is to be extracted from. Color the cells that contain data to be extracted.

    Please remove all personal and proprietary information from the Sample.

    In your reply, Use the "Go Advanced" button and "Manage Attachments" to upload the Sample Workbook.
    Include in your post, the Path to the Main Customers folder and a sample Name of an individual Customer folder, Use "Sample" instead of the actual customer name. Also give us an example of a Customer Workbook Name, including extension.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

Posting Permissions

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