VBA insert one more rule in MACRO, so Target Cells remain blank.

[Livin404]

Greetings,
I have a complex Macro and it does work, however if I have a blank bell in Column B I need to ensure Column F remains blank. Now it is putting "UNIT TRNG MSN" in Column F because there is a blank cell in Column B.

The Code which works is:

Thank you,

Sub Unit_Training_MSN()

    Dim FirstCharacterList As String
    Dim SecondCharacterList As String
    Dim ThirdCharacterList  As String

    FirstCharacterList = "A,B,C,E,F,G,H,I,K,L,M,N,P,Q,R,S,W,0,1,2,4,6,7,8,"
    SecondCharacterList = "E,S,U,"
    ThirdCharacterList = "N,"

    For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
         If InStr(FirstCharacterList, Left(Range("B" & i), 1) & ",") <> 0 Then                    ' If 1st character Found in FirstCharacterList Then
            If InStr(SecondCharacterList, Mid(Range("B" & i), 2, 1) & ",") <> 0 Then            '   If 2nd character Found in SecondCharacterList Then
                If InStr(ThirdCharacterList, Mid(Range("B" & i), 3, 1) & ",") <> 0 Then         '       If 3rd character Found in ThirdCharacterList Then
                    If ActiveSheet.Range("F" & i) = "" Then                                     '           If the accompanying F column cell is blank Then
                        ActiveSheet.Range("F" & i) = "UNIT TRNG MSN"                                  'Make the cell = to "UNIT TRNG MSN"
                    Else                                                                        '           Else
                        ActiveSheet.Range("F" & i) = ActiveSheet.Range("F" & i) & "/UNIT TRNG MSN"    'Append "/UNIT TRNG MSN" to what is already in the F column cell
                    End If
                End If
            End If
        End If
    Next
End Sub

 

[bebo021999]

Its enough

Sub Unit_Training_MSN()

    Dim FirstCharacterList As String
    Dim SecondCharacterList As String
    Dim ThirdCharacterList  As String

    FirstCharacterList = "A,B,C,E,F,G,H,I,K,L,M,N,P,Q,R,S,W,0,1,2,4,6,7,8,"
    SecondCharacterList = "E,S,U,"
    ThirdCharacterList = "N,"

    For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
         If InStr(FirstCharacterList, Left(Range("B" & i), 1) & ",") <> 0 Then                    ' If 1st character Found in FirstCharacterList Then
            If InStr(SecondCharacterList, Mid(Range("B" & i), 2, 1) & ",") <> 0 Then            '   If 2nd character Found in SecondCharacterList Then
                If InStr(ThirdCharacterList, Mid(Range("B" & i), 3, 1) & ",") <> 0 Then         '       If 3rd character Found in ThirdCharacterList Then
                      ActiveSheet.Range("F" & i) = ActiveSheet.Range("F" & i) & "/UNIT TRNG MSN"    'Append "/UNIT TRNG MSN" to what is already in the F column cell
                End If
            End If
        End If
    Next
End Sub

 

[Livin404]

Its enough

Sub Unit_Training_MSN()

    Dim FirstCharacterList As String
    Dim SecondCharacterList As String
    Dim ThirdCharacterList  As String

    FirstCharacterList = "A,B,C,E,F,G,H,I,K,L,M,N,P,Q,R,S,W,0,1,2,4,6,7,8,"
    SecondCharacterList = "E,S,U,"
    ThirdCharacterList = "N,"

    For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
         If InStr(FirstCharacterList, Left(Range("B" & i), 1) & ",") <> 0 Then                    ' If 1st character Found in FirstCharacterList Then
            If InStr(SecondCharacterList, Mid(Range("B" & i), 2, 1) & ",") <> 0 Then            '   If 2nd character Found in SecondCharacterList Then
                If InStr(ThirdCharacterList, Mid(Range("B" & i), 3, 1) & ",") <> 0 Then         '       If 3rd character Found in ThirdCharacterList Then
                      ActiveSheet.Range("F" & i) = ActiveSheet.Range("F" & i) & "/UNIT TRNG MSN"    'Append "/UNIT TRNG MSN" to what is already in the F column cell
                End If
            End If
        End If
    Next
End Sub
[/
[/QUOTE]

I'm afraid date is stil showing up in Cell F eventhough there is nothing visiable in cells in Column B. Everything works fine. I updated an image you can see where this is happen. The strange this is on the very last date is does not do this. Where you see "No Departures" Normally there is a 13 alpha-numeric value, so if it is blank I need the Column F to be blank.

Thank you,

 

[Livin404]

Hello I did get it to work, I had to add another DIM. Works great now. Thank you,