Re: How to post my code after download the VB HTML Maker?
Hi,
Thks. I've facing the problem in convert the text in msgbox to new excel. I've modify the below's code to my module but fail. The code which i use as below:
Option Explicit
Dim wb As Workbook
Dim Sh As Worksheet
Dim r As Integer
Dim i As Integer
Sub MsgBoxTest()
Set wb = Workbooks.Add
Set Sh = wb.Sheets(1)
Cells(1, 1) = "Error Report"
Rows("1:1").Select
Selection.RowHeight = 15
Selection.Font.Bold = True
Selection.Font.Size = 12
Cells(2, 1) = "No"
Cells(2, 1).Select
Selection.Font.Bold = True
Cells(2, 2) = "Errors"
Cells(2, 2).Select
Selection.Font.Bold = True
Cells(3, 2) = "Total Errors"
Cells(3, 2).Select
Selection.Font.Bold = True
ThisWorkbook.Activate
r = 4
For i = 1 To 1
Call Check_GeneralInfoTest
Next i
If IsEmpty(Sh.Cells(4, 2)) Then
wb.Close False
Else
' ??Code to save workbook
End If
End Sub
Sub Check_GeneralInfoTest()
Dim G_ID, G_SupName, G_SupID
Dim Msg As String
G_ID = Trim(ActiveSheet.Cells(i, 1))
If G_ID = "" Then
Msg = " ID # cannot be blank, please check !"
MsgBox Msg, vbExclamation
Cells(i, 1).Select
Sh.Cells(r, 2).Value = Msg
r = r + 1
End If
G_SupName = Trim(ActiveSheet.Cells(i, 2))
If G_SupName = "" Then
Msg = " Supplier Name cannot be blank, please check !"
MsgBox Msg, vbExclamation
Cells(i, 2).Select
Sh.Cells(r, 2).Value = Msg
Sh.Cells(r, 2).EntireColumn.AutoFit
r = r + 1
End If
G_SupID = Trim(ActiveSheet.Cells(i, 3))
If G_SupID = "" Then
Msg = " Supplier ID cannot be blank, please check !"
MsgBox Msg, vbExclamation
Cells(i, 3).Select
Sh.Cells(r, 2).Value = Msg
r = r + 1
End If
End Sub
As the code is long, so I just attached some of my original code as below, can you advice where should i add the code so that the message can move to other excel sheet. Any other way that i can post the whole code so that you can have a clear picture of it? Pls advice. I've try it for many but fail. Appreciate your help. Let me know if you have problem in viewing the code.
<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Multi_Step_validation()
Start_Row = 17
End_Row = Findlast(1)
<SPAN style="color:#00007F">Call</SPAN> Step_Validation("M")
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Step_Validation(step_flag <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>)
Sheet1.Select
<SPAN style="color:#00007F">If</SPAN> step_flag = "M" <SPAN style="color:#00007F">Then</SPAN>
Check_SupplierInfo
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">For</SPAN> i = Start_Row <SPAN style="color:#00007F">To</SPAN> End_Row
<SPAN style="color:#00007F">Call</SPAN> Get_data(i)
p1_tot_substances_weight = 0
p2_tot_weight = 0
Check_GeneralInfo
all_blank = "Y"
<SPAN style="color:#00007F">For</SPAN> j = 7 <SPAN style="color:#00007F">To</SPAN> 139
<SPAN style="color:#00007F">If</SPAN> Trim(Cells(i, j)) <> "" <SPAN style="color:#00007F">Then</SPAN>
all_blank = "N"
<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">For</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Next</SPAN>
<SPAN style="color:#00007F">If</SPAN> all_blank = "Y" <SPAN style="color:#00007F">Then</SPAN>
Rows(i).Select
MsgBox "No Data is detected for this line !", vbExclamation
<SPAN style="color:#00007F">GoTo</SPAN> Next_Line
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_Comp_Status = Trim(ActiveSheet.Cells(i, 9))
<SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> G_Comp_Status
<SPAN style="color:#00007F">Case</SPAN> ""
Cells(i, 9).Select
MsgBox " Component Status cannot be blank, must select either 'Active' or 'Obsolete' !", vbExclamation
<SPAN style="color:#00007F">Case</SPAN> "Active", "Acive"
<SPAN style="color:#00007F">GoTo</SPAN> Proceed
<SPAN style="color:#00007F">Case</SPAN> "Obsolete"
Obsolete
<SPAN style="color:#00007F">GoTo</SPAN> Next_Line
<SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN>
Cells(i, 9).Select
MsgBox " Invalid Component Status, , must select either 'Active' or 'Obsolete' !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
Proceed:
skipP2 = "N"
<SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> P1_EURoHSDirective
<SPAN style="color:#00007F">Case</SPAN> ""
Cells(i, 12).Select
MsgBox " EU RoHS Directive cannot be blank ! Must be either [1], [2], [3] or [4] ", vbExclamation
<SPAN style="color:#00007F">Case</SPAN> "[1] Yes", "[2] Yes with tech exemption*", "[3] Yes but needs product application exemption*", "[4] No"
Check_Active_P1
Check_Active_P2
<SPAN style="color:#00007F">If</SPAN> P1_EURoHSDirective = "[1] Yes" <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">If</SPAN> P1_Replace_AlternativeAvailable <> "[4] No" And P1_Replace_AlternativeAvailable <> "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 75).Select
MsgBox "Since this part already declared as EU RoHS Directive equal '[1]Yes', just leave the alternate/replacement column as blank or set to '[4]No', then just leave all the data in Section 3 as blank.", vbExclamation
skipP2 = "Y"
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> P1_Replace_AlternativeAvailable = "[4] No" <SPAN style="color:#00007F">Or</SPAN> P1_Replace_AlternativeAvailable = "" <SPAN style="color:#00007F">Then</SPAN>
skipP2 = "Y"
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> skipP2 <> "Y" <SPAN style="color:#00007F">Then</SPAN>
Check_Replace_P1
Check_Replace_P2
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN>
Cells(i, 12).Select
MsgBox "Invalid RoHS Directive, must be either [1], [2], [3] or [4]. Please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
Next_Line:
<SPAN style="color:#00007F">Next</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Check_all_blank()
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Check_GeneralInfo()
G_ID = Trim(ActiveSheet.Cells(i, 1))
<SPAN style="color:#00007F">If</SPAN> G_ID = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 1).Select
MsgBox "ID # cannot be blank, please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_SupName = Trim(ActiveSheet.Cells(i, 2))
<SPAN style="color:#00007F">If</SPAN> G_SupName = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 2).Select
MsgBox "Supplier Name cannot be blank, please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_SupID = Trim(ActiveSheet.Cells(i, 3))
<SPAN style="color:#00007F">If</SPAN> G_SupID = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 3).Select
MsgBox "Supplier ID cannot be blank, please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_CPN = Trim(ActiveSheet.Cells(i, 4))
<SPAN style="color:#00007F">If</SPAN> G_CPN = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 4).Select
MsgBox "Customer Part Number(CPN) cannot be blank, please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_MPN = Trim(ActiveSheet.Cells(i, 5))
<SPAN style="color:#00007F">If</SPAN> G_MPN = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 5).Select
MsgBox "Manufacturer Part Number(MPN) cannot be blank, please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_Desc = Trim(ActiveSheet.Cells(i, 6))
<SPAN style="color:#00007F">If</SPAN> G_Desc = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 6).Select
MsgBox "Manufacturer Part Description cannot be blank, please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_Corr_MFR = Trim(ActiveSheet.Cells(i, 7))
<SPAN style="color:#00007F">If</SPAN> Trim(G_Corr_MFR) <> "" And Trim(G_Corr_MFR) = Trim(G_SupName) <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 7).Select
MsgBox "Manufacturer's Corrected Name cannot be same as Supplier Name. Leave it as blank if no correction !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_Corr_MPN = Trim(ActiveSheet.Cells(i, 8))
<SPAN style="color:#00007F">If</SPAN> Trim(G_Corr_MPN) <> "" And Trim(G_Corr_MPN) = Trim(G_MPN) <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 8).Select
MsgBox "Manufacturer's Corrected MPN cannot be same as MPN. Just leave it as blank if no correction needed !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Check_SupplierInfo()
Sheet1.Select
com_name = Trim(ActiveSheet.Cells(5, 5))
<SPAN style="color:#00007F">If</SPAN> com_name = "" <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#007F00">' Selection.Interior.ColorIndex = 15</SPAN>
<SPAN style="color:#007F00">' ActiveCell.AddComment</SPAN>
<SPAN style="color:#007F00">' ActiveCell.Comment.Text Text:="Company name cannot be blank !"</SPAN>
<SPAN style="color:#007F00">' ActiveCell.Comment.Visible = True</SPAN>
Range("E5").Select
MsgBox "Company name cannot be blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
com_addr = Trim(ActiveSheet.Cells(6, 5))
<SPAN style="color:#00007F">If</SPAN> com_addr = "" <SPAN style="color:#00007F">Then</SPAN>
Range("E6").Select
MsgBox "Company address cannot be blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
name_resp = Trim(ActiveSheet.Cells(7, 5))
<SPAN style="color:#00007F">If</SPAN> name_resp = "" <SPAN style="color:#00007F">Then</SPAN>
Range("E7").Select
MsgBox "Name of Respondent cannot be blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
resp_title = Trim(ActiveSheet.Cells(8, 5))
<SPAN style="color:#00007F">If</SPAN> resp_title = "" <SPAN style="color:#00007F">Then</SPAN>
Range("E8").Select
MsgBox "Title of Respondent cannot be blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
resp_phone = Trim(ActiveSheet.Cells(9, 5))
<SPAN style="color:#00007F">If</SPAN> resp_phone = "" <SPAN style="color:#00007F">Then</SPAN>
Range("E9").Select
MsgBox "Respondent Phone number cannot be blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
resp_email = Trim(ActiveSheet.Cells(10, 5))
<SPAN style="color:#00007F">If</SPAN> resp_email = "" <SPAN style="color:#00007F">Then</SPAN>
Range("E10").Select
MsgBox "Respondent email address cannot be blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
resp_date = Trim(ActiveSheet.Cells(11, 5))
<SPAN style="color:#00007F">If</SPAN> resp_date = "" <SPAN style="color:#00007F">Then</SPAN>
Range("E11").Select
MsgBox "Date information is submitted cannot be blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Check_Active_P1()
<SPAN style="color:#00007F">Call</SPAN> Check_EuRoHS(P1_EURoHSDirective, P1_Exemption, P1_URL, P1_CompliantDate, 12, 13, 14, 15, "")
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_LeadIntentionally_YN, P1_Lead_Weight, "Lead/PB", i, 16, 17)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_CadmiumIntentionally_YN, P1_Cadmium_Weight, "Cadmium", i, 18, 19)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_MercuryIntentionally_YN, P1_Mercury_Weight, "Mercury", i, 20, 21)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_HexaChromiumIntentionally_YN, P1_HexaChromium_Weight, "Hexavalent Chromium", i, 22, 23)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_PBBIntentionally_YN, P1_PBB_Weight, "PBB", i, 24, 25)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_PBDEIntentionally_YN, P1_PBDE_Weight, "PBDE", i, 26, 27)
<SPAN style="color:#00007F">Call</SPAN> Check_TotalWeight(P1_<SPAN style="color:#00007F">To</SPAN>talWeight, p1_tot_substances_weight, i, 28)
<SPAN style="color:#00007F">Call</SPAN> Check_Solder(P1_Interconnect, P1_260CpbFree, P1_240CpbFree, P1_MaxTemp, P1_MaxTempDuration, P1_MSL, P1_MCD, P1_CoC, P1_EURoHSDirective, i, 29, 30, 31, 32, 33, 34, 35, 36)
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Check_Replace_P1()
<SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> P1_Replace_AlternativeAvailable
<SPAN style="color:#00007F">Case</SPAN> "[4] No"
URL_Skip_flag = "Y"
<SPAN style="color:#00007F">For</SPAN> j = 76 To 139
<SPAN style="color:#00007F">If</SPAN> Trim(Cells(i, j)) <> "" And j <> 14 <SPAN style="color:#00007F">Then</SPAN>
Cells(i, j).Select
MsgBox "Since alternate/replacement component is not available, just leave " & Cells(i, j).Address(RowAbsolute:=False, ColumnAbsolute:=False) & " as blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
Next
<SPAN style="color:#00007F">Case</SPAN> "[1] Yes", "[2] Yes with tech exemption*", "[3] Yes but needs product application exemption*", "[4] No"
<SPAN style="color:#00007F">If</SPAN> P1_Replace_RoHSMPN = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 77).Select
MsgBox "Please fill up the alternate/replacement MPN !", vbExclamation
<SPAN style="color:#00007F">Else</SPAN>
<SPAN style="color:#00007F">If</SPAN> P1_Replace_RoHSMPN = G_MPN <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 77).Select
MsgBox "Invalid RoHS replacement MPN, cannot be the same as original MPN. Please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Case</SPAN> ""
URL_Skip_flag = "Y"
<SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN>
MsgBox "Invalid RoHS Directive, must be either [1], [2], [3] or [4]. Please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
<SPAN style="color:#00007F">Call</SPAN> Check_EuRoHS(P1_Replace_AlternativeAvailable, P1_Replace_Exemption, P1_Replace_URL, P1_Replace_CompliantDate, 75, 76, 79, 80, URL_Skip_flag)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_Replace_LeadIntentionally_YN, P1_Replace_Lead_Weight, "Lead/PB", i, 81, 82)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_Replace_CadmiumIntentionally_YN, P1_Replace_Cadmium_Weight, "Cadmium", i, 83, 84)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_Replace_MercuryIntentionally_YN, P1_Replace_Mercury_Weight, "Mercury", i, 85, 86)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_Replace_HexaChromium_IntentionallyYN, P1_Replace_HexaChromium_Weight, "Hexavalent Chromium", i, 87, 88)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_Replace_PBB_IntentionallyYN, P1_Replace_PBB_Weight, "PBB", i, 89, 90)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_Replace_PBDE_IntentionallyYN, P1_Replace_PBDE_Weight, "PBDE", i, 91, 92)
<SPAN style="color:#00007F">Call</SPAN> Check_TotalWeight(P1_Replace_TotalWeight, p1_tot_substances_weight, i, 93)
<SPAN style="color:#00007F">Call</SPAN> Check_Solder(P1_Replace_Interconnect, P1_Replace_260CPbFree, P1_Replace_240CPbFree, P1_Replace_MaxTemp, P1_Replace_MaxTempDuration, P1_Replace_MSL, P1_Replace_MCD, P1_Replace_CoC, P1_Replace_EURoHSDirective, i, 94, 95, 96, 97, 98, 99, 100, 101)
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Check_EuRoHS(EURoHSDirective <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>, Exemption <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>, URL <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>, CompliantDate <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>, rohs_col <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, exempt_col <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, url_col <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, compliantdate_col <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, urlskip <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>)
<SPAN style="color:#00007F">If</SPAN> EURoHSDirective = "[2] Yes with tech exemption*" <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">If</SPAN> Exemption = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, exempt_col).Select
MsgBox "For EU RoHS Directive equal to technical exemption, supplier must elaborate on the exemption details !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Else</SPAN>
<SPAN style="color:#00007F">If</SPAN> Exemption <> "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, exempt_col).Select
MsgBox "No need to elaborate the exemption details, just leave it as blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> urlskip <> "Y" <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">If</SPAN> URL = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, url_col).Select
MsgBox "Supplier must provide the Electronic File Name of Spec Sheet (a full URL is preferred if possible) !", vbExclamation
<SPAN style="color:#00007F">Else</SPAN>
<SPAN style="color:#00007F">If</SPAN> UCase(Right(URL, 3)) <> "PDF" And UCase(Right(URL, 3)) <> "DOC" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, url_col).Select
MsgBox "Suspecious file extension. pls check if document is valid !", vbExclamation
<SPAN style="color:#00007F">ElseIf</SPAN> UCase(Left(URL, 4)) <> "HTTP" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, url_col).Select
MsgBox "No URL is detected, pls check if softcopy datasheet is attached !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> EURoHSDirective = "[1] Yes" <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">If</SPAN> CompliantDate = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, compliantdate_col).Select
MsgBox "For EU RoHS Directive equal to '[1]Yes', supplier must fill up the Date Component is Compliant !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Else</SPAN>
<SPAN style="color:#00007F">If</SPAN> CompliantDate <> "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, compliantdate_col).Select
MsgBox "For EU RoHS Directive other than '[1]Yes', No need to fill up the Date of Compliant, just leave it as blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Check_Active_P2()
p2_tot_weight = 0
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_PCB, "Polychlorinated biphenyl (PCBs)", i, 37)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_PolychlorinatedNaphthalene, "Polychlorinated Naphthalene's ", i, 38)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Asbestos, "Asbestos", i, 39)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_AzoColorants, "Azo Colorants", i, 40)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_OzoneDepleting, "Ozone Depleting Substances", i, 41)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_RadioactiveSub, "Radioactive <SPAN style="color:#00007F">Sub</SPAN>stances", i, 42)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_SCChlorinatedParaffins, "Short chain Chlorinated Paraffins", i, 43)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_TPT, "Triphenyl Tin (TPT)", i, 44)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_TBT, "Tributyl Tin (TBT)", i, 45)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_TBTO, "Tributyl Tin Oxide (TBTO)", i, 46)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Antimony, "Antimony/Antimony Compounds", i, 47)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Arsenic, "Arsenic/Arsenic Compounds", i, 48)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Beryllium, "Beryllium/Beryllium Compounds", i, 49)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Bismuth, "Bismuth/Bismuth Compounds", i, 50)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_BrominatedFlameRetardants, "Brominated Flame Retardants", i, 51)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Copper, "Copper/Copper Compounds", i, 52)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Gold, "Gold/Gold Compounds", i, 53)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Magnesium, "Magnesium", i, 54)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Nickel, "Nickel/Nickel Compounds", i, 55)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Palladium, "Palladium/Palladium Compounds", i, 56)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Phthalates, "Phthalates", i, 57)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Selenium, "Selenium/Selenium Compounds", i, 58)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Silver, "Silver/Silver Compounds", i, 59)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_PVC, "Vinyl Chloride Polymer(PVC)", i, 60)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_CarbonTetrachloride, "Carbon Tetrachloride", i, 61)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_ChlorinatedPolymers, "Chlorinated Polymers", i, 62)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_ChloriantedParaffins, "Chlorinated Paraffins", i, 63)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Chromium, "Chromium III and its Compounds", i, 64)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Cobalt, "Cobalt and its Compounds", i, 65)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Cynides, "Cyanides", i, 66)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_HalogenatedFlameRetardants, "Halogenated Flame Retardants", i, 67)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_OrganicTinCompounds, "Organic Tin Compounds", i, 68)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Tellurium, "Tellurium and its Compounds", i, 69)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Thallurium, "Thallurium and its Compounds", i, 70)
<SPAN style="color:#00007F">If</SPAN> p2_tot_weight >= P1_TotalWeight And P1_TotalWeight <> 0 And P1_TotalWeight <> "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 28).Select
MsgBox "The total weight of P2 substances (" & p2_tot_weight & ") cannot be greater or equal to the component overall maximum weight(" & P1_TotalWeight & "), please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Call</SPAN> Check_Plastic(P2_Plastic_OxygenIndex, P2_Plastic_TypeOfPlastic, P2_Plastic_TotalWeight, P2_Plastic_FireRating, i, 71, 72, 73, 74)
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
Sub Check_Replace_P2()
p2_tot_weight = 0
<SPAN style="color:#00007F">If</SPAN> P1_Replace_AlternativeAvailable <> "[4] No" And P1_Replace_AlternativeAvailable <> "" <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_PCB, "Polychlorinated biphenyl (PCBs)", i, 102)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_PolychlorinatedNaphthalene, "Polychlorinated Naphthalene's ", i, 103)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_<SPAN style="color:#00007F">As</SPAN>bestos, "<SPAN style="color:#00007F">As</SPAN>bestos", i, 104)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_AzoColorants, "Azo Colorants", i, 105)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_OzoneDepleting, "Ozone Depleting Substances", i, 106)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Radioactive<SPAN style="color:#00007F">Sub</SPAN>, "Radioactive <SPAN style="color:#00007F">Sub</SPAN>stances", i, 107)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_SCChlorinatedParaffins, "Short chain Chlorinated Paraffins", i, 108)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_TPT, "Triphenyl Tin (TPT)", i, 109)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_TBT, "Tributyl Tin (TBT)", i, 110)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_TBTO, "Tributyl Tin Oxide (TBTO)", i, 111)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Antimony, "Antimony/Antimony Compounds", i, 112)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Arsenic, "Arsenic/Arsenic Compounds", i, 113)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Beryllium, "Beryllium/Beryllium Compounds", i, 114)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Bismuth, "Bismuth/Bismuth Compounds", i, 115)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_BrominatedFlameRetardants, "Brominated Flame Retardants", i, 116)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Copper, "Copper/Copper Compounds", i, 117)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Gold, "Gold/Gold Compounds", i, 118)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Magnesium, "Magnesium", i, 119)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Nickel, "Nickel/Nickel Compounds", i, 120)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Palladium, "Palladium/Palladium Compounds", i, 121)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Phthalates, "Phthalates", i, 122)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Selenium, "Selenium/Selenium Compounds", i, 123)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Silver, "Silver/Silver Compounds", i, 124)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_PVC, "Vinyl Chloride Polymer(PVC)", i, 125)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_CarbonTetrachloride, "Carbon Tetrachloride", i, 126)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_ChlorinatedPolymers, "Chlorinated Polymers", i, 127)
<SPAN </FONT>
Thks & bst rgds,
Chui Ping
Hi,
Thks. I've facing the problem in convert the text in msgbox to new excel. I've modify the below's code to my module but fail. The code which i use as below:
Option Explicit
Dim wb As Workbook
Dim Sh As Worksheet
Dim r As Integer
Dim i As Integer
Sub MsgBoxTest()
Set wb = Workbooks.Add
Set Sh = wb.Sheets(1)
Cells(1, 1) = "Error Report"
Rows("1:1").Select
Selection.RowHeight = 15
Selection.Font.Bold = True
Selection.Font.Size = 12
Cells(2, 1) = "No"
Cells(2, 1).Select
Selection.Font.Bold = True
Cells(2, 2) = "Errors"
Cells(2, 2).Select
Selection.Font.Bold = True
Cells(3, 2) = "Total Errors"
Cells(3, 2).Select
Selection.Font.Bold = True
ThisWorkbook.Activate
r = 4
For i = 1 To 1
Call Check_GeneralInfoTest
Next i
If IsEmpty(Sh.Cells(4, 2)) Then
wb.Close False
Else
' ??Code to save workbook
End If
End Sub
Sub Check_GeneralInfoTest()
Dim G_ID, G_SupName, G_SupID
Dim Msg As String
G_ID = Trim(ActiveSheet.Cells(i, 1))
If G_ID = "" Then
Msg = " ID # cannot be blank, please check !"
MsgBox Msg, vbExclamation
Cells(i, 1).Select
Sh.Cells(r, 2).Value = Msg
r = r + 1
End If
G_SupName = Trim(ActiveSheet.Cells(i, 2))
If G_SupName = "" Then
Msg = " Supplier Name cannot be blank, please check !"
MsgBox Msg, vbExclamation
Cells(i, 2).Select
Sh.Cells(r, 2).Value = Msg
Sh.Cells(r, 2).EntireColumn.AutoFit
r = r + 1
End If
G_SupID = Trim(ActiveSheet.Cells(i, 3))
If G_SupID = "" Then
Msg = " Supplier ID cannot be blank, please check !"
MsgBox Msg, vbExclamation
Cells(i, 3).Select
Sh.Cells(r, 2).Value = Msg
r = r + 1
End If
End Sub
As the code is long, so I just attached some of my original code as below, can you advice where should i add the code so that the message can move to other excel sheet. Any other way that i can post the whole code so that you can have a clear picture of it? Pls advice. I've try it for many but fail. Appreciate your help. Let me know if you have problem in viewing the code.
<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Multi_Step_validation()
Start_Row = 17
End_Row = Findlast(1)
<SPAN style="color:#00007F">Call</SPAN> Step_Validation("M")
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Step_Validation(step_flag <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>)
Sheet1.Select
<SPAN style="color:#00007F">If</SPAN> step_flag = "M" <SPAN style="color:#00007F">Then</SPAN>
Check_SupplierInfo
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">For</SPAN> i = Start_Row <SPAN style="color:#00007F">To</SPAN> End_Row
<SPAN style="color:#00007F">Call</SPAN> Get_data(i)
p1_tot_substances_weight = 0
p2_tot_weight = 0
Check_GeneralInfo
all_blank = "Y"
<SPAN style="color:#00007F">For</SPAN> j = 7 <SPAN style="color:#00007F">To</SPAN> 139
<SPAN style="color:#00007F">If</SPAN> Trim(Cells(i, j)) <> "" <SPAN style="color:#00007F">Then</SPAN>
all_blank = "N"
<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">For</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Next</SPAN>
<SPAN style="color:#00007F">If</SPAN> all_blank = "Y" <SPAN style="color:#00007F">Then</SPAN>
Rows(i).Select
MsgBox "No Data is detected for this line !", vbExclamation
<SPAN style="color:#00007F">GoTo</SPAN> Next_Line
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_Comp_Status = Trim(ActiveSheet.Cells(i, 9))
<SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> G_Comp_Status
<SPAN style="color:#00007F">Case</SPAN> ""
Cells(i, 9).Select
MsgBox " Component Status cannot be blank, must select either 'Active' or 'Obsolete' !", vbExclamation
<SPAN style="color:#00007F">Case</SPAN> "Active", "Acive"
<SPAN style="color:#00007F">GoTo</SPAN> Proceed
<SPAN style="color:#00007F">Case</SPAN> "Obsolete"
Obsolete
<SPAN style="color:#00007F">GoTo</SPAN> Next_Line
<SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN>
Cells(i, 9).Select
MsgBox " Invalid Component Status, , must select either 'Active' or 'Obsolete' !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
Proceed:
skipP2 = "N"
<SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> P1_EURoHSDirective
<SPAN style="color:#00007F">Case</SPAN> ""
Cells(i, 12).Select
MsgBox " EU RoHS Directive cannot be blank ! Must be either [1], [2], [3] or [4] ", vbExclamation
<SPAN style="color:#00007F">Case</SPAN> "[1] Yes", "[2] Yes with tech exemption*", "[3] Yes but needs product application exemption*", "[4] No"
Check_Active_P1
Check_Active_P2
<SPAN style="color:#00007F">If</SPAN> P1_EURoHSDirective = "[1] Yes" <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">If</SPAN> P1_Replace_AlternativeAvailable <> "[4] No" And P1_Replace_AlternativeAvailable <> "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 75).Select
MsgBox "Since this part already declared as EU RoHS Directive equal '[1]Yes', just leave the alternate/replacement column as blank or set to '[4]No', then just leave all the data in Section 3 as blank.", vbExclamation
skipP2 = "Y"
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> P1_Replace_AlternativeAvailable = "[4] No" <SPAN style="color:#00007F">Or</SPAN> P1_Replace_AlternativeAvailable = "" <SPAN style="color:#00007F">Then</SPAN>
skipP2 = "Y"
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> skipP2 <> "Y" <SPAN style="color:#00007F">Then</SPAN>
Check_Replace_P1
Check_Replace_P2
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN>
Cells(i, 12).Select
MsgBox "Invalid RoHS Directive, must be either [1], [2], [3] or [4]. Please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
Next_Line:
<SPAN style="color:#00007F">Next</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Check_all_blank()
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Check_GeneralInfo()
G_ID = Trim(ActiveSheet.Cells(i, 1))
<SPAN style="color:#00007F">If</SPAN> G_ID = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 1).Select
MsgBox "ID # cannot be blank, please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_SupName = Trim(ActiveSheet.Cells(i, 2))
<SPAN style="color:#00007F">If</SPAN> G_SupName = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 2).Select
MsgBox "Supplier Name cannot be blank, please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_SupID = Trim(ActiveSheet.Cells(i, 3))
<SPAN style="color:#00007F">If</SPAN> G_SupID = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 3).Select
MsgBox "Supplier ID cannot be blank, please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_CPN = Trim(ActiveSheet.Cells(i, 4))
<SPAN style="color:#00007F">If</SPAN> G_CPN = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 4).Select
MsgBox "Customer Part Number(CPN) cannot be blank, please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_MPN = Trim(ActiveSheet.Cells(i, 5))
<SPAN style="color:#00007F">If</SPAN> G_MPN = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 5).Select
MsgBox "Manufacturer Part Number(MPN) cannot be blank, please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_Desc = Trim(ActiveSheet.Cells(i, 6))
<SPAN style="color:#00007F">If</SPAN> G_Desc = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 6).Select
MsgBox "Manufacturer Part Description cannot be blank, please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_Corr_MFR = Trim(ActiveSheet.Cells(i, 7))
<SPAN style="color:#00007F">If</SPAN> Trim(G_Corr_MFR) <> "" And Trim(G_Corr_MFR) = Trim(G_SupName) <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 7).Select
MsgBox "Manufacturer's Corrected Name cannot be same as Supplier Name. Leave it as blank if no correction !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
G_Corr_MPN = Trim(ActiveSheet.Cells(i, 8))
<SPAN style="color:#00007F">If</SPAN> Trim(G_Corr_MPN) <> "" And Trim(G_Corr_MPN) = Trim(G_MPN) <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 8).Select
MsgBox "Manufacturer's Corrected MPN cannot be same as MPN. Just leave it as blank if no correction needed !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Check_SupplierInfo()
Sheet1.Select
com_name = Trim(ActiveSheet.Cells(5, 5))
<SPAN style="color:#00007F">If</SPAN> com_name = "" <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#007F00">' Selection.Interior.ColorIndex = 15</SPAN>
<SPAN style="color:#007F00">' ActiveCell.AddComment</SPAN>
<SPAN style="color:#007F00">' ActiveCell.Comment.Text Text:="Company name cannot be blank !"</SPAN>
<SPAN style="color:#007F00">' ActiveCell.Comment.Visible = True</SPAN>
Range("E5").Select
MsgBox "Company name cannot be blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
com_addr = Trim(ActiveSheet.Cells(6, 5))
<SPAN style="color:#00007F">If</SPAN> com_addr = "" <SPAN style="color:#00007F">Then</SPAN>
Range("E6").Select
MsgBox "Company address cannot be blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
name_resp = Trim(ActiveSheet.Cells(7, 5))
<SPAN style="color:#00007F">If</SPAN> name_resp = "" <SPAN style="color:#00007F">Then</SPAN>
Range("E7").Select
MsgBox "Name of Respondent cannot be blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
resp_title = Trim(ActiveSheet.Cells(8, 5))
<SPAN style="color:#00007F">If</SPAN> resp_title = "" <SPAN style="color:#00007F">Then</SPAN>
Range("E8").Select
MsgBox "Title of Respondent cannot be blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
resp_phone = Trim(ActiveSheet.Cells(9, 5))
<SPAN style="color:#00007F">If</SPAN> resp_phone = "" <SPAN style="color:#00007F">Then</SPAN>
Range("E9").Select
MsgBox "Respondent Phone number cannot be blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
resp_email = Trim(ActiveSheet.Cells(10, 5))
<SPAN style="color:#00007F">If</SPAN> resp_email = "" <SPAN style="color:#00007F">Then</SPAN>
Range("E10").Select
MsgBox "Respondent email address cannot be blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
resp_date = Trim(ActiveSheet.Cells(11, 5))
<SPAN style="color:#00007F">If</SPAN> resp_date = "" <SPAN style="color:#00007F">Then</SPAN>
Range("E11").Select
MsgBox "Date information is submitted cannot be blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Check_Active_P1()
<SPAN style="color:#00007F">Call</SPAN> Check_EuRoHS(P1_EURoHSDirective, P1_Exemption, P1_URL, P1_CompliantDate, 12, 13, 14, 15, "")
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_LeadIntentionally_YN, P1_Lead_Weight, "Lead/PB", i, 16, 17)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_CadmiumIntentionally_YN, P1_Cadmium_Weight, "Cadmium", i, 18, 19)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_MercuryIntentionally_YN, P1_Mercury_Weight, "Mercury", i, 20, 21)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_HexaChromiumIntentionally_YN, P1_HexaChromium_Weight, "Hexavalent Chromium", i, 22, 23)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_PBBIntentionally_YN, P1_PBB_Weight, "PBB", i, 24, 25)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_PBDEIntentionally_YN, P1_PBDE_Weight, "PBDE", i, 26, 27)
<SPAN style="color:#00007F">Call</SPAN> Check_TotalWeight(P1_<SPAN style="color:#00007F">To</SPAN>talWeight, p1_tot_substances_weight, i, 28)
<SPAN style="color:#00007F">Call</SPAN> Check_Solder(P1_Interconnect, P1_260CpbFree, P1_240CpbFree, P1_MaxTemp, P1_MaxTempDuration, P1_MSL, P1_MCD, P1_CoC, P1_EURoHSDirective, i, 29, 30, 31, 32, 33, 34, 35, 36)
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Check_Replace_P1()
<SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> P1_Replace_AlternativeAvailable
<SPAN style="color:#00007F">Case</SPAN> "[4] No"
URL_Skip_flag = "Y"
<SPAN style="color:#00007F">For</SPAN> j = 76 To 139
<SPAN style="color:#00007F">If</SPAN> Trim(Cells(i, j)) <> "" And j <> 14 <SPAN style="color:#00007F">Then</SPAN>
Cells(i, j).Select
MsgBox "Since alternate/replacement component is not available, just leave " & Cells(i, j).Address(RowAbsolute:=False, ColumnAbsolute:=False) & " as blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
Next
<SPAN style="color:#00007F">Case</SPAN> "[1] Yes", "[2] Yes with tech exemption*", "[3] Yes but needs product application exemption*", "[4] No"
<SPAN style="color:#00007F">If</SPAN> P1_Replace_RoHSMPN = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 77).Select
MsgBox "Please fill up the alternate/replacement MPN !", vbExclamation
<SPAN style="color:#00007F">Else</SPAN>
<SPAN style="color:#00007F">If</SPAN> P1_Replace_RoHSMPN = G_MPN <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 77).Select
MsgBox "Invalid RoHS replacement MPN, cannot be the same as original MPN. Please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Case</SPAN> ""
URL_Skip_flag = "Y"
<SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN>
MsgBox "Invalid RoHS Directive, must be either [1], [2], [3] or [4]. Please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
<SPAN style="color:#00007F">Call</SPAN> Check_EuRoHS(P1_Replace_AlternativeAvailable, P1_Replace_Exemption, P1_Replace_URL, P1_Replace_CompliantDate, 75, 76, 79, 80, URL_Skip_flag)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_Replace_LeadIntentionally_YN, P1_Replace_Lead_Weight, "Lead/PB", i, 81, 82)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_Replace_CadmiumIntentionally_YN, P1_Replace_Cadmium_Weight, "Cadmium", i, 83, 84)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_Replace_MercuryIntentionally_YN, P1_Replace_Mercury_Weight, "Mercury", i, 85, 86)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_Replace_HexaChromium_IntentionallyYN, P1_Replace_HexaChromium_Weight, "Hexavalent Chromium", i, 87, 88)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_Replace_PBB_IntentionallyYN, P1_Replace_PBB_Weight, "PBB", i, 89, 90)
<SPAN style="color:#00007F">Call</SPAN> Check_RoHs(P1_Replace_PBDE_IntentionallyYN, P1_Replace_PBDE_Weight, "PBDE", i, 91, 92)
<SPAN style="color:#00007F">Call</SPAN> Check_TotalWeight(P1_Replace_TotalWeight, p1_tot_substances_weight, i, 93)
<SPAN style="color:#00007F">Call</SPAN> Check_Solder(P1_Replace_Interconnect, P1_Replace_260CPbFree, P1_Replace_240CPbFree, P1_Replace_MaxTemp, P1_Replace_MaxTempDuration, P1_Replace_MSL, P1_Replace_MCD, P1_Replace_CoC, P1_Replace_EURoHSDirective, i, 94, 95, 96, 97, 98, 99, 100, 101)
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Check_EuRoHS(EURoHSDirective <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>, Exemption <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>, URL <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>, CompliantDate <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>, rohs_col <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, exempt_col <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, url_col <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, compliantdate_col <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, urlskip <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>)
<SPAN style="color:#00007F">If</SPAN> EURoHSDirective = "[2] Yes with tech exemption*" <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">If</SPAN> Exemption = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, exempt_col).Select
MsgBox "For EU RoHS Directive equal to technical exemption, supplier must elaborate on the exemption details !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Else</SPAN>
<SPAN style="color:#00007F">If</SPAN> Exemption <> "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, exempt_col).Select
MsgBox "No need to elaborate the exemption details, just leave it as blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> urlskip <> "Y" <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">If</SPAN> URL = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, url_col).Select
MsgBox "Supplier must provide the Electronic File Name of Spec Sheet (a full URL is preferred if possible) !", vbExclamation
<SPAN style="color:#00007F">Else</SPAN>
<SPAN style="color:#00007F">If</SPAN> UCase(Right(URL, 3)) <> "PDF" And UCase(Right(URL, 3)) <> "DOC" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, url_col).Select
MsgBox "Suspecious file extension. pls check if document is valid !", vbExclamation
<SPAN style="color:#00007F">ElseIf</SPAN> UCase(Left(URL, 4)) <> "HTTP" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, url_col).Select
MsgBox "No URL is detected, pls check if softcopy datasheet is attached !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> EURoHSDirective = "[1] Yes" <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">If</SPAN> CompliantDate = "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, compliantdate_col).Select
MsgBox "For EU RoHS Directive equal to '[1]Yes', supplier must fill up the Date Component is Compliant !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Else</SPAN>
<SPAN style="color:#00007F">If</SPAN> CompliantDate <> "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, compliantdate_col).Select
MsgBox "For EU RoHS Directive other than '[1]Yes', No need to fill up the Date of Compliant, just leave it as blank !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> Check_Active_P2()
p2_tot_weight = 0
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_PCB, "Polychlorinated biphenyl (PCBs)", i, 37)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_PolychlorinatedNaphthalene, "Polychlorinated Naphthalene's ", i, 38)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Asbestos, "Asbestos", i, 39)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_AzoColorants, "Azo Colorants", i, 40)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_OzoneDepleting, "Ozone Depleting Substances", i, 41)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_RadioactiveSub, "Radioactive <SPAN style="color:#00007F">Sub</SPAN>stances", i, 42)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_SCChlorinatedParaffins, "Short chain Chlorinated Paraffins", i, 43)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_TPT, "Triphenyl Tin (TPT)", i, 44)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_TBT, "Tributyl Tin (TBT)", i, 45)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_TBTO, "Tributyl Tin Oxide (TBTO)", i, 46)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Antimony, "Antimony/Antimony Compounds", i, 47)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Arsenic, "Arsenic/Arsenic Compounds", i, 48)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Beryllium, "Beryllium/Beryllium Compounds", i, 49)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Bismuth, "Bismuth/Bismuth Compounds", i, 50)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_BrominatedFlameRetardants, "Brominated Flame Retardants", i, 51)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Copper, "Copper/Copper Compounds", i, 52)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Gold, "Gold/Gold Compounds", i, 53)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Magnesium, "Magnesium", i, 54)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Nickel, "Nickel/Nickel Compounds", i, 55)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Palladium, "Palladium/Palladium Compounds", i, 56)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Phthalates, "Phthalates", i, 57)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Selenium, "Selenium/Selenium Compounds", i, 58)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Silver, "Silver/Silver Compounds", i, 59)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_PVC, "Vinyl Chloride Polymer(PVC)", i, 60)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_CarbonTetrachloride, "Carbon Tetrachloride", i, 61)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_ChlorinatedPolymers, "Chlorinated Polymers", i, 62)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_ChloriantedParaffins, "Chlorinated Paraffins", i, 63)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Chromium, "Chromium III and its Compounds", i, 64)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Cobalt, "Cobalt and its Compounds", i, 65)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Cynides, "Cyanides", i, 66)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_HalogenatedFlameRetardants, "Halogenated Flame Retardants", i, 67)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_OrganicTinCompounds, "Organic Tin Compounds", i, 68)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Tellurium, "Tellurium and its Compounds", i, 69)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Thallurium, "Thallurium and its Compounds", i, 70)
<SPAN style="color:#00007F">If</SPAN> p2_tot_weight >= P1_TotalWeight And P1_TotalWeight <> 0 And P1_TotalWeight <> "" <SPAN style="color:#00007F">Then</SPAN>
Cells(i, 28).Select
MsgBox "The total weight of P2 substances (" & p2_tot_weight & ") cannot be greater or equal to the component overall maximum weight(" & P1_TotalWeight & "), please check !", vbExclamation
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Call</SPAN> Check_Plastic(P2_Plastic_OxygenIndex, P2_Plastic_TypeOfPlastic, P2_Plastic_TotalWeight, P2_Plastic_FireRating, i, 71, 72, 73, 74)
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
Sub Check_Replace_P2()
p2_tot_weight = 0
<SPAN style="color:#00007F">If</SPAN> P1_Replace_AlternativeAvailable <> "[4] No" And P1_Replace_AlternativeAvailable <> "" <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_PCB, "Polychlorinated biphenyl (PCBs)", i, 102)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_PolychlorinatedNaphthalene, "Polychlorinated Naphthalene's ", i, 103)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_<SPAN style="color:#00007F">As</SPAN>bestos, "<SPAN style="color:#00007F">As</SPAN>bestos", i, 104)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_AzoColorants, "Azo Colorants", i, 105)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_OzoneDepleting, "Ozone Depleting Substances", i, 106)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Radioactive<SPAN style="color:#00007F">Sub</SPAN>, "Radioactive <SPAN style="color:#00007F">Sub</SPAN>stances", i, 107)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_SCChlorinatedParaffins, "Short chain Chlorinated Paraffins", i, 108)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_TPT, "Triphenyl Tin (TPT)", i, 109)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_TBT, "Tributyl Tin (TBT)", i, 110)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_TBTO, "Tributyl Tin Oxide (TBTO)", i, 111)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Antimony, "Antimony/Antimony Compounds", i, 112)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Arsenic, "Arsenic/Arsenic Compounds", i, 113)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Beryllium, "Beryllium/Beryllium Compounds", i, 114)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Bismuth, "Bismuth/Bismuth Compounds", i, 115)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_BrominatedFlameRetardants, "Brominated Flame Retardants", i, 116)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Copper, "Copper/Copper Compounds", i, 117)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Gold, "Gold/Gold Compounds", i, 118)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Magnesium, "Magnesium", i, 119)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Nickel, "Nickel/Nickel Compounds", i, 120)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Palladium, "Palladium/Palladium Compounds", i, 121)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Phthalates, "Phthalates", i, 122)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Selenium, "Selenium/Selenium Compounds", i, 123)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_Silver, "Silver/Silver Compounds", i, 124)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_PVC, "Vinyl Chloride Polymer(PVC)", i, 125)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_CarbonTetrachloride, "Carbon Tetrachloride", i, 126)
<SPAN style="color:#00007F">Call</SPAN> Check_P2(P2_Replace_ChlorinatedPolymers, "Chlorinated Polymers", i, 127)
<SPAN </FONT>
Thks & bst rgds,
Chui Ping