Combine Multiple MsgBox to one-CodePudding

I am trying to combine multiple msgbox but i couldnot figure out. Here is my Code:

If InStr(ThisWorkbook.Worksheets("DailyReport").Range("F8").Value, "DCT") > 0 Then
    If IsEmpty(Sheet2.Range("G34").Value) Then
        MsgBox ("The Following Test is not Performed " & Sheet2.Range("E34").Value)
    End If

    If IsEmpty(Sheet2.Range("G35").Value) Then
        MsgBox ("The Following Test is not Performed " & Sheet2.Range("E35").Value)
    End If

    If IsEmpty(Sheet2.Range("G36").Value) Then
        MsgBox ("The Following Test is not Performed " & Sheet2.Range("E36").Value)
    End If
End If

I want to search for word DCT in Cell F8 of Worksheets DailyReport and if it exist then I want to look at multiple cell like G34,G35,G36.... and if these cell are empty then display msgbox saying "The following Test is Not performed: E34,E35,E36...."

Let's Say if G34 and G35 is Empty then the msg box should display The following Test is not Performed:

Cell value in E34
Cell Value in E35

Msgbox Should have continue and Cancel button

If User hit Continue Then Continue the sub

If user Hit Cancel then Exit the sub

CodePudding user response：

Sub CombineMsgBoxes()

Dim Found As Boolean
Found = False

If InStr(ThisWorkbook.Worksheets("DailyReport").Range("F8").Value, "DCT") > 0 Then
    Found = True
    Dim Msg As String
    Msg = "The Following Tests are not Performed: "
    If IsEmpty(Sheet2.Range("G34").Value) Then
        Msg = Msg & Sheet2.Range("E34").Value & ", "
    End If
    If IsEmpty(Sheet2.Range("G35").Value) Then
        Msg = Msg & Sheet2.Range("E35").Value & ", "
    End If
    If IsEmpty(Sheet2.Range("G36").Value) Then
        Msg = Msg & Sheet2.Range("E36").Value & ", "
    End If

    If Msg <> "The Following Tests are not Performed: " Then
        Dim Response As Integer
        Response = MsgBox(Msg, vbYesNo, "Warning")
        If Response = vbNo Then
            Exit Sub
        End If
    End If
End If

If Not Found Then
    MsgBox "DCT was not found in Cell F8", vbOKOnly, "Error"
    Exit Sub
End If

End Sub

CodePudding user response：

I want to look at multiple cell like G34,G35,G36....

if these cell are empty then display msgbox saying "The following Test is Not performed: E34,E35,E36...."

G34,G35,G36.... Looks like this range is dynamic? Or will it always be these 3? And if it is dynamic then how are you deciding the range. For example why G34 and not G1? Or till where do you want to check? Till last cell in G? All this will decide how you write a concise vba code. I am going to assume that you want to check till last cell in column G. In case it is say from G34 to say G60(just an example), then change the For Next Loop from For i = 34 To lRow to For i = 34 To 60

Is this what you are trying? (UNTESTED)

Option Explicit

Sub Sample()
    Dim i As Long
    Dim lRow As Long
    Dim CellAddress As String
    
    If InStr(ThisWorkbook.Worksheets("DailyReport").Range("F8").Value, "DCT") > 0 Then
        
        With Sheet2
            '~~> Find last row in Col G
            lRow = .Range("G" & .Rows.Count).End(xlUp).Row
            
            '~~> Check the range for blank cells
            For i = 34 To lRow
                If Len(Trim(.Range("G" & i).Value2)) = 0 Then
                    CellAddress = CellAddress & "," & "E" & i
                End If
            Next i
        End With
        
        '~~> Check if any addresses were found
        If CellAddress <> "" Then
            CellAddress = Mid(CellAddress, 2)
            
            Dim ret As Integer
            
            '~~> Ask user. There is no CONTINUE button. Use YES/NO
            ret = MsgBox("The following Test is Not performed:" & _
                          vbNewLine & CellAddress & vbNewLine & _
                          "Would you like to continue?", vbYesNo)
            If ret = vbYes Then
                '~~> Do what you want
            Else
                '~~> You may not need the else/exit sub part
                '~~> Depending on what you want to do
                Exit Sub
            End If
            '
            '
            '~~> Rest of the code
            '
            '
        End If
    End If
End Sub