VBA-Excel/DropDownMenu_Values at Portoflio · creatlyre/VBA-Excel · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
Private Sub DropDownMenuValue_No(range1 As Integer)

Call ClearCells(range1)
Dim LockRange As Variant, ExitLoop As Boolean
Dim ErrorNumber As Integer
Dim PreCall As Variant, BuildRFP As Variant, Communication As Variant, ReviewBids As Variant

    Set PreCall = Range("A1:B60").Find("Pre")
    Set BuildRFP = Range("A1:B60").Find("Build")
    Set Communication = Range("A1:B60").Find("Comm")
    Set ReviewBids = Range("A1:B60").Find("Bids")


'checks in which section is "no" countg first from the lowest
    If range1 > ReviewBids.Row - 1 Then
        ErrorNumber = range1 - ReviewBids.Row + 1
            Do
                LockRange = InputBox("Please provide a comment", "Error Code: 4RFP" & ErrorNumber)
                Select Case LockRange
                    Case Is = "False"
                        ExitLoop = False

                    Case Is = ""
                        ExitLoop = False

                    Case Else
                        If Len(LockRange) = 0 Then
                            ExitLoop = False

                        Else
                            ExitLoop = True

                        End If
                End Select
            Loop Until ExitLoop = True
            Cells(range1, 6) = "4RFP" & ErrorNumber
            Cells(range1, 7) = LockRange
    ElseIf range1 > Communication.Row - 1 Then
        ErrorNumber = range1 - Communication.Row + 1
            Do
                LockRange = InputBox("Please provide a comment", "Error Code: 3RFP" & ErrorNumber)
                Select Case LockRange
                    Case Is = "False"
                        ExitLoop = False

                    Case Is = ""
                        ExitLoop = False

                    Case Else
                        If Len(LockRange) = 0 Then
                            ExitLoop = False

                        Else
                            ExitLoop = True

                        End If
                End Select
            Loop Until ExitLoop = True
            Cells(range1, 6) = "3RFP" & ErrorNumber
            Cells(range1, 7) = LockRange
    ElseIf range1 > BuildRFP.Row - 1 Then
        ErrorNumber = range1 - BuildRFP.Row + 1
            Do
                LockRange = InputBox("Please provide a comment", "Error Code: 2RFP" & ErrorNumber)
                Select Case LockRange
                    Case Is = "False"
                        ExitLoop = False

                    Case Is = ""
                        ExitLoop = False

                    Case Else
                        If Len(LockRange) = 0 Then
                            ExitLoop = False

                        Else
                            ExitLoop = True

                        End If
                End Select
            Loop Until ExitLoop = True
            Cells(range1, 6) = "2RFP" & ErrorNumber
            Cells(range1, 7) = LockRange
    ElseIf range1 > PreCall.Row - 1 Then
        ErrorNumber = range1 - PreCall.Row
            Do
                LockRange = InputBox("Please provide a comment", "Error Code: 1RFP" & ErrorNumber)
                Select Case LockRange
                    Case Is = "False"
                        ExitLoop = False

                    Case Is = ""
                        ExitLoop = False

                    Case Else
                        If Len(LockRange) = 0 Then
                            ExitLoop = False

                        Else
                            ExitLoop = True

                        End If
                End Select
            Loop Until ExitLoop = True
            Cells(range1, 6) = "1RFP" & ErrorNumber
            Cells(range1, 7) = LockRange
    End If


            'Call QualityCheck

End Sub

Private Sub DropDownMenuValue_Yes(range1 As Integer)
        Call ClearCells(range1)
        Cells(range1, 6).Interior.ColorIndex = 48
        'Call QualityCheck

End Sub

Private Sub DropDownMenuValue_NA(range1 As Integer)
    Call ClearCells(range1)
    'Call QualityCheck
    Cells(range1, 6).Interior.ColorIndex = 48
    Cells(range1, 7).Interior.ColorIndex = 48
End Sub


Private Sub ClearCells(range1 As Integer)

    Cells(range1, 6) = " "
    Cells(range1, 7) = " "
    Cells(range1, 6).Interior.ColorIndex = 2
    Cells(range1, 7).Interior.ColorIndex = 2
    'Call QualityCheck

End Sub