alter sub to clear cells within a range

[John Caines]

Hello All.
I very kindly maanaged to get a 'Clear Cells' sub from the board. (Thank you Fluff!)
The sub code is below;

Sub ResetCells()
   With Selection
      .Font.Name = "Ariel"
      .Interior.Color = xlNone
      .Font.Color = vbBlack
      .ClearContents
   End With
End Sub

Is there anyway I can alter this so it only will clear the following ranges,
J4:AN15,J17:AN20,J24:T31

I'm not sure how to alter the above code so as to accomplish this.
Any help here would be great.
Many thanks in advance..
John C

 

[Fluff]

Like

Sub ResetCells()
   With Range("J4:AN15,J17:AN20,J24:T31")
      .Font.Name = "Ariel"
      .Interior.Color = xlNone
      .Font.Color = vbBlack
      .ClearContents
   End With
End Sub

 

[John Caines]

Hi there Flufff!!!
Many thanks again!

Just tried it,, it's working perfectly!!,,,
I'm still trying to finish off the spreadsheet from the other day with ticks and crosses etc (Windings) that you originally helped me with.

Many thanks again for this,, it's perfect,,,,
Just 1 thing if I may,,, rather than start another post,,, as it relates to this (kind of),, and it's for the same sheet.

You kindly wrote some code for my ticks and crosses which is now as follows

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Updateby Extendoffice
    If Target.Cells.Count = 1 Then
                If Not Intersect(Target, Range("J4:AN15,J17:AN20,J24:T31")) Is Nothing Then
            With Target
                .Font.Name = "Wingdings"
                .Font.Size = 12
                If .Value = " û " Then
                    .Value = "ü"
                    Target.Interior.Color = vbGreen
                    Target.Font.Color = vbBlack
                Else
                    .Value = " û "
                    Target.Interior.Color = vbRed
                    Target.Font.Color = vbWhite
                End If
            End With
        End If
        Cancel = True
    End If
End Sub

This is all great,, but I have just 1 issue.
If I go to say cell C4 which is merged accross with D4,,,, this holds some text.
If I want to change the text,, usually you would double click in the cell.
But I can't double click on any cell from C4 to I20,,,,I think the above code isn't letting me?
I have to press F2 on my keyboard to enter the cell to alter the text.
Is there anyway around this Fluff?
I haven't a clue here,,,but I'm guessing it is because of this VBA code above?

Hope you can advise.
And thanks again for the alteration to the code 1st mentioned in this post.
Great stuff.
My spreadsheet is almost done.

Yours sincerely
A very grateful
John C

 

[Fluff]

Try

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("J4:AN15,J17:AN20,J24:T31")) Is Nothing Then
      Cancel = True
      With Target
          .Font.Name = "Wingdings"
          .Font.Size = 12
          If .Value = " û " Then
              .Value = "ü"
              Target.Interior.Color = vbGreen
              Target.Font.Color = vbBlack
          Else
              .Value = " û "
              Target.Interior.Color = vbRed
              Target.Font.Color = vbWhite
          End If
      End With
   End If
End Sub

 

[John Caines]

Many thanks again Fluff!!!!!!
I never in a million years would have gotten that,,,really specialised stuff this VBA.
Thanks again,, it's great.

I was a little hasty in my last reply, I didn't test your new code properly it seems Fluff.

Sub ResetCells()
   With Range("J4:AN15,J17:AN20,J24:T31")
      .Font.Name = "Ariel"
      .Interior.Color = xlNone
      .Font.Color = vbBlack
      .ClearContents
   End With
End Sub

What this is now doing is correctly targeting the correct range of cells to clear.

But before, it would clear only cells that are selected.
Now it's clearing every cell mentioned in the ranges in the code.

Can this be adjusted Fluff, to only clear cells that are currently selected within the ranges in the code?

But as to new code,,,the double click is working perfectly,,,
Many thanks Fluff for your help here, much appreciated.
Yours sincerely
John C

PS,, just to add,, I might use this sub as well,,, as a 'Clear All' Button!!

 

[Fluff]

Ok, try

Sub ResetCells()
   With Intersect(Selection, Range("J4:AN15,J17:AN20,J24:T31"))
      .Font.Name = "Ariel"
      .Interior.Color = xlNone
      .Font.Color = vbBlack
      .ClearContents
   End With
End Sub

 

[John Caines]

Excellent Stuff Fluff!
That's exactly right now...
All is good...The codes are now perfect!
Many thanks again.


1 Final question if I may...(you might know the answer Fluff,,,,,I can't get Google to answer this for me yet
I now have 13 tabs in the workbook.
Each is a Month,, IE Jan/Feb/March etc etc,, & 1 will just be a READ ME sheet explaining everything

Every Month sheet is 100% identical.

https://www.dropbox.com/s/1jlii0mtk74suzj/can-work-on-all-12-month-sheets.jpg?dl=0

Is there a way that the above code in the screenshot,, (The large code) can work in all the 12 MTH sheets without having to copy/paste them into each TAB?

I know the module will work in each,, as I assign a button/Image to each sheet,,,
But the Sheet 2(JAN) code (Large code),,, does this still need to be entered 12 times Fluff into each Month Tab,, or is there a way around this?

I just don't want to have 12 VBA codes the same in the workbook if there's a way for it to all work with just 1 code in VBA that will work for all 12 sheets.

Hope the above makes sense.

Again, many thanks for this.
It's taken me hrs to produce,,, but worth the effort!!

Help here is always greatly appreciated.
Yours sincerely
John C

 

[Fluff]

This needs to go in the ThisWorkbook module

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
   If Sh.Name = "READ ME" Then Exit Sub
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("J4:AN15,J17:AN20,J24:T31")) Is Nothing Then
      Cancel = True
      With Target
          .Font.Name = "Wingdings"
          .Font.Size = 12
          If .Value = " û " Then
              .Value = "ü"
              Target.Interior.Color = vbGreen
              Target.Font.Color = vbBlack
          Else
              .Value = " û "
              Target.Interior.Color = vbRed
              Target.Font.Color = vbWhite
          End If
      End With
   End If
End Sub

 

[John Caines]

Excellent!!!!!
Fluff,,, top job!
Really ,,,, thanks very much for this,,,

Just tried it,,,all works great!


I'll just try and finish off the read me page,,, but it's all working great!

I've said it before, and I'll say it again,, greatly appreciate your help with this..
================

Just as a ramble.....I've used a wonderful hand written font in this workbook called 'Throw Your Hands Up In The Air'
https://www.dafont.com/throw-my-hands-up-in-the-air.font

I would love to somehow embed it into this excel workbook.
I've googled it, seems you can in Powerpoint, you can in Word,,, but not Excel!

I'm not sure if Excel 2019 will allow embedding of fonts,,, but wish this could be done.
I'll just upload my workbook with a link to the above URL so someone can download/install on their PC.


If anyone knows of any 'TRICK' to embed fonts into excel, I'm all ears,, but Google's told me no you can't do it,,,so I'm guessing this is a no no?

Thanks Fluff again.
Have a great Sunday
(Great,,,,,, England's just pulled 2 back!)

Yours sincerely
JohnC

 

[Fluff]

AFAIK there is no way of embedding fonts in Xl