Merged code gives a Run Time Error

[ipbr21054]

Hi,

I have two buttons on my worksheet but would rather have only the one.
Thus meaning i need to merge the two codes together.

The two codes are shown below.
Once i run the code the first code runs & does whats its supposed to do but when doing the second part of the code i ger a run time error 13 Type Missmatch.
The text below is then shown in yellow.

Private Sub GrassSummaryIncomeSheet_Click()    Dim strFileName As String
    
        strFileName = "C:\Users\Ian\Desktop\GRASS CUTTING\CURRENT GRASS SHEETS\INCOME 2019-2020\" & _
        Range("J3") & "_" & Format(Month(DateValue(Range("G3") & " 1, " & "2019")), "00") & " " & Range("G3") & ".pdf"


    If Dir(strFileName) <> vbNullString Then
        MsgBox "INCOME GRASS SHEET " & Range("G3") & " " & Range("J3") & " WAS NOT SAVED AS IT ALREADY EXISTS", vbCritical + vbOKOnly, "INCOME SUMMARY GRASS SHEET MESSAGE"
        Exit Sub
    End If
    
    With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True
        MsgBox "INCOME GRASS SHEET " & Range("G3") & " " & Range("J3") & " WAS SAVED SUCCESSFULLY", vbInformation + vbOKOnly, "INCOME SUMMARY GRASS SHEET MESSAGE"
        Range("G5:H30").ClearContents
        Range("G5").Select
        ActiveWorkbook.Save
    End With


End Sub

Private Sub TransferIncomeInfo_Click()    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("G3").Value
    strDate = ws.Range("G5").Value
    With sh
        Set rFndCell = .Range("C5:C17").Find(stFnd, LookIn:=xlValues)
        If Not rFndCell Is Nothing Then
            fRow = rFndCell.Row
            If CDate(strDate) > CDate("05/04/2019") Then
                sh.Cells(fRow, 4).Resize(, 2).Value = ws.Range("J31,K31").Value
            Else:
                sh.Cells(fRow - 12, 4).Resize(, 2).Value = ws.Range("J31,K31").Value
            End If
            MsgBox "Transfer Has Been Completed", vbInformation + vbOKOnly, "INCOME TRANSFER SHEET MESSAGE"
        Else
            MsgBox "DOES NOT EXIST"
        End If
    End With
End Sub

Ive merged them now & have this one piece of code shown.

Option Explicit

Private Sub GrassSummaryIncomeSheet_Click()
    Dim strFileName As String
    
        strFileName = "C:\Users\Ian\Desktop\GRASS CUTTING\CURRENT GRASS SHEETS\INCOME 2019-2020\" & _
        Range("J3") & "_" & Format(Month(DateValue(Range("G3") & " 1, " & "2019")), "00") & " " & Range("G3") & ".pdf"


    If Dir(strFileName) <> vbNullString Then
        MsgBox "INCOME GRASS SHEET " & Range("G3") & " " & Range("J3") & " WAS NOT SAVED AS IT ALREADY EXISTS", vbCritical + vbOKOnly, "INCOME SUMMARY GRASS SHEET MESSAGE"
        Exit Sub
    End If
    
    With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True
        MsgBox "INCOME GRASS SHEET " & Range("G3") & " " & Range("J3") & " WAS SAVED SUCCESSFULLY", vbInformation + vbOKOnly, "INCOME SUMMARY GRASS SHEET MESSAGE"
        Range("G5:H30").ClearContents
        Range("G5").Select
        ActiveWorkbook.Save
    End With
    
    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("G3").Value
    strDate = ws.Range("G5").Value
    With sh
        Set rFndCell = .Range("C5:C17").Find(stFnd, LookIn:=xlValues)
        If Not rFndCell Is Nothing Then
            fRow = rFndCell.Row
[COLOR=#ff0000]            If CDate(strDate) > CDate("05/04/2019") Then[/COLOR]
                sh.Cells(fRow, 4).Resize(, 2).Value = ws.Range("J31,K31").Value
            Else:
                sh.Cells(fRow - 12, 4).Resize(, 2).Value = ws.Range("J31,K31").Value
            End If
            MsgBox "Transfer Has Been Completed", vbInformation + vbOKOnly, "INCOME TRANSFER SHEET MESSAGE"
        Else
            MsgBox "DOES NOT EXIST"
        End If
    End With
End Sub

 

[Joe4]

OK, so is it working?

If not, what results are you experiencing?

 

[ipbr21054]

Variable not defined.

If Dir(strFileName) <> vbNullString Then

 

[Joe4]

Private Sub INCOMETRANSFER()
[COLOR=#0000ff]    If Dir(strFileName) <> vbNullString Then
        MsgBox "INCOME GRASS SHEET " & Range("G3") & " " & Range("J3") & " WAS NOT SAVED AS IT ALREADY EXISTS", vbCritical + vbOKOnly, "INCOME SUMMARY GRASS SHEET MESSAGE"
        PDFExists = True
        Exit Sub
    Else
        PDFExists = False
    End If
[/COLOR]
    Dim strFileName As String
    
        strFileName = "C:\Users\Ian\Desktop\GRASS CUTTING\CURRENT GRASS SHEETS\INCOME 2019-2020\" & _
        Range("J3") & "_" & Format(Month(DateValue(Range("G3") & " 1, " & "2019")), "00") & " " & Range("G3") & ".pdf"

[COLOR=#ff0000]    If Dir(strFileName) <> vbNullString Then
        MsgBox "INCOME GRASS SHEET " & Range("G3") & " " & Range("J3") & " WAS NOT SAVED AS IT ALREADY EXISTS", vbCritical + vbOKOnly, "INCOME SUMMARY GRASS SHEET MESSAGE"
        Exit Sub
    End If[/COLOR]
    
    With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True
        MsgBox "INCOME GRASS SHEET " & Range("G3") & " " & Range("J3") & " WAS SAVED SUCCESSFULLY", vbInformation + vbOKOnly, "INCOME SUMMARY GRASS SHEET MESSAGE"

    End With

End Sub

The new code that I provided (in blue) is supposed to replace what you originally had (in red). As you can see if you look closely, it is the same code, just with a few extra lines.

So move the blue code over top of the red code.

 

[ipbr21054]

So its now like this ?

Private Sub INCOMETRANSFER()

    Dim strFileName As String
    
        strFileName = "C:\Users\Ian\Desktop\GRASS CUTTING\CURRENT GRASS SHEETS\INCOME 2019-2020\" & _
        Range("J3") & "_" & Format(Month(DateValue(Range("G3") & " 1, " & "2019")), "00") & " " & Range("G3") & ".pdf"


    If Dir(strFileName) <> vbNullString Then
        MsgBox "INCOME GRASS SHEET " & Range("G3") & " " & Range("J3") & " WAS NOT SAVED AS IT ALREADY EXISTS", vbCritical + vbOKOnly, "INCOME SUMMARY GRASS SHEET MESSAGE"
        PDFExists = True
        Exit Sub
    Else
        PDFExists = False
    End If
    
    With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True
        MsgBox "INCOME GRASS SHEET " & Range("G3") & " " & Range("J3") & " WAS SAVED SUCCESSFULLY", vbInformation + vbOKOnly, "INCOME SUMMARY GRASS SHEET MESSAGE"


    End With


End Sub

See what an idiot i am

 

[Joe4]

Yes, that is the way it should be.

 

[ipbr21054]

Now working thanks

 

[Joe4]

You are welcome.