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
Bookmarks