Value entered into incorrect months cell

[ipbr21054]

Afternoon,
Please could you advise on my code.
I have a worksheet called GINCOME & also GSUMMARY
I use a command button to copy cell values from GINCOME & paste onto GSUMMARY.

Due to the tax year we will have 2 April months,upto End of tax year April 5th then New tax year April 6th onwards.
This is where the issue lies.

I have now completed my work for this tax year but the correct value was copied BUT placed into the incorrect April cell on the GSUMMARY worksheet.
See attached screen shot
You will see that the value of £255.00 & 61 miles are in the row 17 BUT they should of been placed in row 5

Here is the code for the command button.

Private Sub TransferButton_Click()
    
    Call INCOMETRANSFER
    
    If PDFExists Then
    Exit Sub
    
    Else
        Call SUMMARYTRANSFER
    End If
    INCOMEMONTHYEAR.Show
End Sub

Private Sub INCOMETRANSFER()

    Dim strFileName As String
    
        strFileName = "C:\Users\Ian\Desktop\GRASS CUTTING\CURRENT GRASS SHEETS\INCOME 2021-2022\" & _
        Format(Month(DateValue(Range("A3") & " 1, " & "2021")), "00") & " " & Range("A3") & " " & Range("D3") & ".pdf"

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

End Sub

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
        Set rFndCell = .Range("C5:C17").Find(stFnd, LookIn:=xlValues)
        If Not rFndCell Is Nothing Then
            fRow = rFndCell.Row
            If CDate(strDate) > CDate("05/04/2021") Then
                sh.Cells(fRow, 4).Resize(, 1).Value = ws.Range("D31").Value
                sh.Cells(fRow, 5).Resize(, 1).Value = ws.Range("E31").Value
            Else:
                sh.Cells(fRow - 12, 4).Resize(, 1).Value = ws.Range("D31").Value
                sh.Cells(fRow - 12, 5).Resize(, 1).Value = ws.Range("E31").Value
            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 With
End Sub

 

[ipbr21054]

Im still looking into this incorrect pasted cell value.

I believe the issue is this piece of the code but i dont understand how / what its doing.

            If CDate(strDate) > CDate("05/04/2021") Then
                sh.Cells(fRow, 4).Resize(, 1).Value = ws.Range("D31").Value
                sh.Cells(fRow, 5).Resize(, 1).Value = ws.Range("E31").Value
            Else:
                sh.Cells(fRow - 12, 4).Resize(, 1).Value = ws.Range("D31").Value
                sh.Cells(fRow - 12, 5).Resize(, 1).Value = ws.Range("E31").Value
            End If

So looking at this full code i see it looks at the Month in cell A3 & also the date in cell A5 on the worksheet G INCOME
It the goes to the worksheet G SUMMARY & looks at the cell range C5:C17 of which is the months from April through to the following April.

Now this is the part of the code where it needs to decide if the April values should be pasted in cell D5 or D17
This is the part of the code i cant see how it knows which to paste it to.

This is the where i need to sort it for it to operate correctly

Please advise thanks.

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
        Set rFndCell = .Range("C5:C17").Find(stFnd, LookIn:=xlValues)
        If Not rFndCell Is Nothing Then
            fRow = rFndCell.Row
            If CDate(strDate) > CDate("05/04/2021") Then
                sh.Cells(fRow, 4).Resize(, 1).Value = ws.Range("D31").Value
                sh.Cells(fRow, 5).Resize(, 1).Value = ws.Range("E31").Value
            Else:
                sh.Cells(fRow - 12, 4).Resize(, 1).Value = ws.Range("D31").Value
                sh.Cells(fRow - 12, 5).Resize(, 1).Value = ws.Range("E31").Value
            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 With
End Sub