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. [Blocked Image: http://www.vbaexpress.com/forum/images/smilies/sad2.gif]
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.