Advice to remove redundant line of code currently in use

[ipbr21054]

I am using the code below.

On my worksheet in cell B3 i used to enter a month.
When i typed APRIL i would see a userform pop up "APRILFORM.Show" but now this isnt required so i need to remove that part of the code.
In the code below i have removed the part shown in Red BUT i keep seeing the msgbox "DOES NOT EXIST"

Please advise if i removed something i shouldnt have or do i also need to remove something else ?

Basically there is no need know to lookif APRIL is in the cell & pop up the Msgbox

Private Sub SUMMARYTRANSFER()
    Dim rFndCell As Range
    Dim strData As String
    Dim stFnd As String
    Dim fRow As Long
    Dim sh As Worksheet
    Dim ws As Worksheet
    Dim strDate As String

    Set ws = Sheets("G INCOME")
    Set sh = Sheets("G SUMMARY")
    stFnd = ws.Range("A3").Value
    strDate = ws.Range("A5").Value
        With sh
    If Range("A3").Value = "APRIL" Then
        APRILFORM.Show
    Else

        Set rFndCell = .Range("C6:C16").Find(stFnd, LookIn:=xlValues)
        If Not rFndCell Is Nothing Then
            fRow = rFndCell.Row
            If CDate(strDate) > CDate("05/04/2023") Then
                sh.Cells(fRow, 4).Resize(, 1).Value = ws.Range("D31").Value
                sh.Cells(fRow, 5).Resize(, 1).Value = ws.Range("E31").Value
            Else:

            End If
            MsgBox "TRANSFER TO SUMMARY SHEET ALSO COMPLETED", vbInformation + vbOKOnly, "SUMMARY TO TRANSFER SHEET COMPLETED MESSAGE"
        Else
            MsgBox "DOES NOT EXIST", vbCritical + vbOKOnly, "SUMMARY TO TRANSFER SHEET FAILED MESSAGE"
            Range("A5").Select
        End If
        Range("A3:B3").ClearContents
        Range("E3").ClearContents
        Range("C3").ClearContents
        Range("A5:B30").ClearContents
        Range("A5:A30").NumberFormat = "@"
        Range("A5").Select
        ActiveWorkbook.Save
        
    End If
    End With
    
End Sub

 

[nemmi69]

No problem .It looked like you had deleted the with sh