ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,738
- Office Version
- 2007
- Platform
- Windows
Evening,
I have a worksheet called G INCOME
At the end of the month i press a command button which creates a pdf file of that months takings & also copies the total profit & mileage for that month & pastes it on the worksheet called G SUMMARY.
The pdf side of things work fine.
The profit / mileage is the issue.
On the G SUMMARY worksheet are the months April May June through to April next year.
April D5:E5
May D6:E6
June D7:E7
April D17:E17
Ive just done Aprils paperwork & pressed the command button but as opposed to the figures etc going in This years April D5:E5 its put into next years April D17:E17
Below is the code in use.
Command Button.
G SUMMARY worksheet code.
I have a worksheet called G INCOME
At the end of the month i press a command button which creates a pdf file of that months takings & also copies the total profit & mileage for that month & pastes it on the worksheet called G SUMMARY.
The pdf side of things work fine.
The profit / mileage is the issue.
On the G SUMMARY worksheet are the months April May June through to April next year.
April D5:E5
May D6:E6
June D7:E7
April D17:E17
Ive just done Aprils paperwork & pressed the command button but as opposed to the figures etc going in This years April D5:E5 its put into next years April D17:E17
Below is the code in use.
Command Button.
VBA Code:
Private Sub TransferButton_Click()
Call INCOMETRANSFER
If PDFExists Then
' Do nothing
Else
Call SUMMARYTRANSFER
End If
INCOMEMONTHYEAR.Show
End Sub
G SUMMARY worksheet code.
Code:
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/2020") 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").ClearContents
Range("B3").ClearContents
Range("C3").ClearContents
Range("A5:B30").ClearContents
Range("A5:A30").NumberFormat = "@"
Range("A5").Select
ActiveWorkbook.Save
End With
End Sub