macro1.bas

Introduction: 1. Macro1: AddFailureModeCol is used to the test report generated from GNPO Rpt Tools

Attribute VB_Name = "Macro1"
Sub AddFailureModeCol()
Attribute AddFailureModeCol.VB_Description = "Macro recorded 11/16/2007 by vdkg48"
Attribute AddFailureModeCol.VB_ProcData.VB_Invoke_Func = "b\n14"


'*************************************************************************************************
'*|   AddFailureModeCol Macro
'*|   2Jan 2008 by th
'*|
'*|   this macro is Capable of 1000 rows only
'*|   to change the capability, simply replace 1000 with smaller or larger number whichever you want
'*|
'*|   NOTE: approximate running time will be around 1 min
'*|
'**************************************************************************************************

Dim i As Integer, n As Integer, j As Integer
Dim x(1999) As String
i = 1

'Find out the starting point of the row
Sheets("Summary").Select
Range("A1").Select
x(0) = ActiveCell.Value

Do Until x(i) = "Test Code"
ActiveCell.Offset(1, 0).Activate
i = i + 1
x(i) = ActiveCell.Value
Loop

'add title "Failure Mode"
    ActiveCell.Offset(0, 11).Activate
    ActiveCell.FormulaR1C1 = "Failure Mode"
    Selection.Font.Bold = True

' allow value list
    Range("AA6").Select
    ActiveCell.FormulaR1C1 = "Test"
    Range("AA7").Select
    ActiveCell.FormulaR1C1 = "Design - HW"
    Range("AA8").Select
    ActiveCell.FormulaR1C1 = "Design - SW"
    Range("AA9").Select
    ActiveCell.FormulaR1C1 = "Material"
    Range("AA10").Select
    ActiveCell.FormulaR1C1 = "Process"
    Range("AA11").Select
    ActiveCell.FormulaR1C1 = "Workmanship"
    Range("AA12").Select
    ActiveCell.FormulaR1C1 = "NTF"
    Range("AA13").Select
    ActiveCell.FormulaR1C1 = "TBA"

    
 
' data validation
Range("A1").Activate
ActiveCell.Offset(i + 1, 11).Activate

For j = 1 To 1000
    ActiveCell.Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=$AA$6:$AA$13"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    ActiveCell.Offset(1, 0).Activate
    
Next j

Range("A1").Activate
ActiveCell.Offset(i + 1, 0).Activate


End Sub