Looking for advice / recommendations

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,416
Office Version
2007
Platform
Windows
Hi,
This below now works but can you help put the yyyy on the same line code as mmmm please.

Code:
Private Sub Worksheet_Activate()

With Sheets("GRASS INCOME")
      .Range("C3") = UCase(Format(Now, "mmmm"))
    With .Range("C3")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        With .Font
            .Name = "Calibri"
            .FontStyle = "Bold"
            .Size = 28
        End With
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent1
            .TintAndShade = 0.799981688894314
            .PatternTintAndShade = 0
        End With
        Range("A5").Select
        End With
        End With
End Sub
 

Some videos you may like

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,846
Office Version
2016
Platform
Windows
Are you using a non-english edition of excel ?

As for worrying about loosing the formatting, I don't think you should because you are only clearing the contents of the cells ie : ClearContents.
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,416
Office Version
2007
Platform
Windows
Nearly but not quite.

If i use this
Code:
.Range("C3") = UCase(Format(Now, "mmmm"))
I see JULY

If i use the code you advise i see
Jul-19

Im trying to get it to be JULY 2019
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,416
Office Version
2007
Platform
Windows
Hi,
I have a workaround which takes car of it,see below,

Code:
Private Sub Worksheet_Activate()

With Sheets("GRASS INCOME")
        .Range("A3") = UCase(Format(Now, "mmmm"))
        .Range("D3") = Year(Now)
    With .Range("C3")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        With .Font
            .Name = "Calibri"
            .FontStyle = "Bold"
            .Size = 28
        End With
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        With .Interior
        .Pattern = xlSolid
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
        End With
        Range("A5").Select
        End With
        End With
End Sub


BUT
Can you advise the edit so the date & year are part of the saved pdf, see below.
[CODE]Private Sub GrassSummarySheet_Click()
    Dim strFileName As String
    
    strFileName = "C:\Users\Ian\Desktop\GRASS CUTTING\\" & Range("C3").Value & ".pdf"
    If Dir(strFileName) <> vbNullString Then
        MsgBox "SUMMARY SHEET " & Range("C3").Value & " WAS NOT SAVED AS IT ALLREADY EXISTS", vbCritical + vbOKOnly
        Exit Sub
    End If
    
    With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True
        MsgBox "SUMMARY SHEET " & Range("C3").Value & " WAS SAVED SUCCESSFULLY", vbInformation + vbOKOnly
        Range("A5:B41").ClearContents
        Range("A5").Select
        ActiveWorkbook.Save
    End With
End Sub
Currently C3 BUT need to edit it correctly so its A3 D3 then i think it will work
[/CODE]
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,846
Office Version
2016
Platform
Windows
Nearly but not quite.

If i use this
Code:
.Range("C3") = UCase(Format(Now, "mmmm"))
I see JULY

If i use the code you advise i see
Jul-19

Im trying to get it to be JULY 2019
That is strange... It works for me as expected.

Try this and see how it goes:
Code:
.Range("C3") = UCase(Format(Now, "mmmm")) & " " & UCase(Format(Now, "yyyy"))
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,416
Office Version
2007
Platform
Windows
Hi,
Its the same.
I will leave it and follow on with my work around if you could read the follow up post

Thanks
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,846
Office Version
2016
Platform
Windows
Hi,
Its the same.
I will leave it and follow on with my work around if you could read the follow up post

Thanks
Are you applying some custom number format to cell C3 ?

You post15 looks fine to me it just places the year in cell D3.
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,416
Office Version
2007
Platform
Windows
Hi,
No im not.

I have had to move on now as it was holding me up.

Post 15 works fine apart from the button code that it used to save the excel range as a pdf file.

Originally the cell to take the name for the pdf file was C3 but as i was haiving an issue i decided to do this.
I used cell A3 for the date of which cell A3 now shows JULY which is perfect

I used cell D3 for the year of which cell D3 now shows 2019 which is perfect

So in order to save the pdf file the new code needs to take the month from cell A3 & the year from cell D3 then save.
So the pdf file will be JULY 2019

This is the olf save code from when it was in cell C£
I now need to edit it,of which i cant so it takes into account the 2 cells for month & year being A3 & D3

Code:
Private Sub GrassSummarySheet_Click()    Dim strFileName As String
    
    strFileName = "C:\Users\Ian\Desktop\GRASS CUTTING\CURRENT GRASS SHEETS\" & Range("A3,D3").Value & ".pdf"
    If Dir(strFileName) <> vbNullString Then
        MsgBox "GRASS SHEET " & Range("A3,D3").Value & " WAS NOT SAVED AS IT ALLREADY EXISTS", vbCritical + vbOKOnly, "SUMMARY GRASS SHEET MESSAGE"
        Exit Sub
    End If
    
    With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True
        MsgBox "GRASS SHEET " & Range("A3,D3").Value & " WAS SAVED SUCCESSFULLY", vbInformation + vbOKOnly, "SUMMARY GRASS SHEET MESSAGE"
        Range("A5:B41").ClearContents
        Range("A5").Select
        ActiveWorkbook.Save
    End With
End Sub
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,846
Office Version
2016
Platform
Windows
Try this (Changes in red)
Code:
Private Sub GrassSummarySheet_Click()
    Dim strFileName As String
    
    strFileName = "C:\Users\Ian\Desktop\GRASS CUTTING\CURRENT GRASS SHEETS\" & [COLOR=#ff0000]Range("A3") & " " & Range("D3")[/COLOR] & ".pdf"
    If Dir(strFileName) <> vbNullString Then
        MsgBox "GRASS SHEET " & [COLOR=#ff0000]Range("A3") & " " & Range("D3")[/COLOR] & " WAS NOT SAVED AS IT ALLREADY EXISTS", vbCritical + vbOKOnly, "SUMMARY GRASS SHEET MESSAGE"
        Exit Sub
    End If
    
    With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True
        MsgBox "GRASS SHEET " & [COLOR=#ff0000]Range("A3") & " " & Range("D3")[/COLOR] & " WAS SAVED SUCCESSFULLY", vbInformation + vbOKOnly, "SUMMARY GRASS SHEET MESSAGE"
        Range("A5:B41").ClearContents
        Range("A5").Select
        ActiveWorkbook.Save
    End With
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,102,889
Messages
5,489,543
Members
407,697
Latest member
Lotte_4

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top