+ Reply to Thread
Results 1 to 3 of 3

Consolidate data from multiple excel files into single file

Hybrid View

hkkk Consolidate data from... 08-22-2013, 12:12 AM
RobertMika Re: Consolidate data from... 08-22-2013, 02:00 AM
cytop Re: Consolidate data from... 08-22-2013, 03:34 AM
  1. #1
    Registered User
    Join Date
    08-21-2013
    Location
    Malaysia
    MS-Off Ver
    Excel 2007
    Posts
    3

    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
    Forum Expert RobertMika's Avatar
    Join Date
    06-22-2009
    Location
    Haverhill, UK
    MS-Off Ver
    Excel 2003-13
    Posts
    1,530

    Re: Consolidate data from multiple excel files into single file

    Cross posted
    http://www.ozgrid.com/forum/showthread.php?t=181991
    If you are http://www.excelforum.com/image.php?type=sigpic&userid=125481&dateline=1392355029happy with the results, please add to the contributor's
    reputation by clicking the reputation icon (star icon).




    If you are satisfied with the solution(s) provided, please mark your thread as Solved.
    Select Thread Tools-> Mark thread as Solved.
    To undo, select Thread Tools-> Mark thread as Unsolved.
    http://www.excelaris.co.uk

  3. #3
    Forum Expert
    Join Date
    02-14-2009
    Location
    .
    MS-Off Ver
    ................
    Posts
    2,840

    Re: Consolidate data from multiple excel files into single file

    Also: http://www.vbaexpress.com/forum/show...-file&p=295700

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. [SOLVED] Pull data from the same cell across multiple csv files and place into a single excel file
    By rbmrrbmr in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 04-18-2013, 10:53 AM
  2. How to consolidate data from multiple excel files into single sheet in new book?
    By Pradeep M B in forum Excel Programming / VBA / Macros
    Replies: 8
    Last Post: 04-07-2013, 09:37 AM
  3. [SOLVED] Macro to read the multiple csv files and consolidate into single excel
    By parthmittal2007 in forum Excel Programming / VBA / Macros
    Replies: 20
    Last Post: 01-03-2013, 03:40 AM
  4. Consolidate Data from Multiple Files (Different File Names) into a Master File
    By dspraveen_23 in forum Excel Programming / VBA / Macros
    Replies: 9
    Last Post: 12-08-2012, 12:59 PM
  5. Replies: 1
    Last Post: 01-27-2010, 03:06 AM

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1