Please advise on my code

[ipbr21054]

Hi,

I wish to transfer values from one worksheet to another worksheet given the values on three specific cells.
I have some information for you.

Worksheet G INCOME
Current month in cell G3
Current year in cell J3
I then enter a date value in cell G5

Worksheet G SUMMARY
Months range cell C5:C17 so APRIL C5 MAY C6 JUNE C7 ........... MAY C16 APRIL C17

So the code is supposed to work like this.
I press my transfer button & the code looks at the current month G3
It then looks at the current year J3
Now it then looks at my entered date value in cell G5
The code then decides if the date value in cell G5 is before or after 5th APRIL " end of tax year"

Once the code has decided it then transfers to my G SUMMARY worksheet in one of the APRIL locations.
So short example.

APRIL
MAY
JUNE
MONTHS CONTINUE DOWN THE SHEET
FEBRUARY
MARCH
APRIL

So the first APRIL is in cell C5 and would represent the BEFORE

The second APRIL is in cell C17 and would represent the AFTER

The values in G INCOME cell J31 need to be placed in G SUMMARY D5 or D17

The values in G INCOME cell K31 need to be placed in G SUMMARY E5 or E17

The code below transfers ok but not quite got the grasp of deciding the BEFORE or AFTER part & correct cell placement

Option ExplicitPrivate 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

 

[ipbr21054]

Ive now sorted this.

see below.

Option ExplicitPrivate 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