Sub C2R()
Dim RCount As Integer
RCount = 2
Dim FillIn, FillIn2
Set FillIn = Worksheets("Fill-in Forms")
Set FillIn2 = Worksheets("fillinforms2")
Application.ScreenUpdating = False
Dim ENCommentIndex%, OptionalForm%
Dim OptionalList$
OptionalList = "CA0106, CA0121, CA0121, CA0199, CA0240, CA0240, CA0305, CA0409, CA0410, CA0444, CA0444, CA2010, CA2010, CA2011, CA2033, CA2033, CA2048, CA2048, CA2054, CA2054, CA2055, CA2055, CA2067, CA2071, CA2071, CA2502, CA9910, CA9910, CA9916, CA9933, CA9933,"
For Each EN In FillIn.Range("B2:DG2")
ENCommentIndex = InStr(FillIn.Cells(2, EN.Column + 1).Value, EN.Value)
OptionalForm = InStr(OptionalList, EN.Value)
If InStr(EN.Value, "Comm") = 0 Then
For Each Fill In FillIn.Range("A3:A166")
If Cells(Fill.Row, EN.Column).Value <> "" Then
EN.Copy (FillIn2.Range("A" & RCount)) 'en name
Fill.Copy (FillIn2.Range("B" & RCount)) 'field desc
Cells(Fill.Row, EN.Column).Copy (FillIn2.Range("C" & RCount)) 'X
If ENCommentIndex > 0 Then
Cells(Fill.Row, EN.Column + 1).Copy (FillIn2.Range("D" & RCount)) 'comment
End If
If OptionalForm = 0 Then
FillIn2.Range("E" & RCount) = "Conditional"
Else
FillIn2.Range("E" & RCount) = "Optional"
End If
RCount = RCount + 1
End If
Next
End If
Next
End Sub
Sub RemoveDeletedEN()
Dim red_en$
red_en = "CA2018, CA2018, CA2021, CA2021, CA2027, CA2027, CA2030, CA2030, CA2071, CA2071, CA9923, CA9923, CA9930, CA9930, CA9960, CA9960, CA2016, CA2016, CA2017, CA2017,"
Dim fillinforms2
Set fillinforms2 = Worksheets("fillinforms2")
For Each EN In fillinforms2.Range("A2:A300")
If EN.Value <> "" And InStr(red_en, EN.Value) <> 0 Then
fillinforms2.Range("F" & EN.Row) = "deleted"
End If
Next
End Sub