Make use of existing code advice

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,226
Office Version
  1. 2007
Platform
  1. Windows
Morning,
Please let me explain.

On my worksheet i have 2 command buttons.

Command button 1 is used for when i start to add values to the worksheet untill my specified range is full.
It saves a pdf file "example JULY 2021 (1)" of those values inserted & it then on worksheet called G SUMMARY enters the INCOME VALUE & MILEAGE VALUE in the respective cells.

Now as im still working in JULY & the range was full hence (1) i start to complete the range untill full once again.
Command button 2 is used to save a pdf file like before & saves it as "example JULY 2021 (2)"

In the code below i have a pop up msgbox to tell me to now ADD the INCOME VALUE & MILEAGE VALUE to the G SUMMARY sheet.
THis is where i need to new code to look at the value in the cell & add this sheets value to it.

Example.
Codes saves pdf file (1)
Code looks at G SUMMARY sheet.
Finds the month in question & pastes the INCOME VALUE & MILEAGE VALUE from sheet (1)
Lets say,
INCOME VALUE £100
MILEAGE VALUE 64

After the next sheet is complete.
Codes saves pdf file (2)
Finds the month in question & now does a sum to add to what is already in the cell.
So,
INCOME VALUE is currently £100 & new value is £66 so enter £166 in the cell
MILEAGE VALUE 64 + 22 so enter 86 in the cell

Here are the codes to assist you.

Code for sheet 2 "need new code to replace the msgbox message currently in use"

Rich (BB code):
Private Sub SecondMonthsSheet_Click()
    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") & " " & Range("E3") & ".pdf"

                                                                                             
       
    If Dir(strFileName) <> vbNullString Then
        MsgBox "GRASS CUTTING INCOME SHEET " & Range("A3") & " " & Range("E3") & " " & Range("D3") & " 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 "GRASS CUTTING INCOME SHEET " & Range("A3") & " " & Range("E3") & " " & Range("D3") & " WAS SAVED SUCCESSFULLY", vbInformation + vbOKOnly, "INCOME SUMMARY GRASS SHEET MESSAGE"
        Range("A5:B30").ClearContents
        Range("A3").MergeArea.ClearContents
        Range("E3").ClearContents
        Range("A5").Select
        Range("A5:A30").NumberFormat = "@"
        ActiveWorkbook.Save
        INCOMEMONTHYEAR.Show
    End With
    MsgBox "NOW ADD SHEET (2) INCOME TO THE G SUMMARY SHEET", vbInformation, "SUCCESSFUL SHEET (2) SAVED MESSAGE"
End Sub

Code to find month in question which currently pastes a value but will use code again but this time calculate then paste.

Rich (BB 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/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

Sorry for the long winded text but i have learning issues & need to convince myself as i type it out
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

Forum statistics

Threads
1,214,834
Messages
6,121,874
Members
449,056
Latest member
ruhulaminappu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top