PDA

View Full Version : Solved: clear cells if, like reset



mperrah
07-18-2007, 09:42 PM
Hello all,
I have this sub on a worksheet,
I have a sub to clear the contents of a working range,
but the sub that puts a check in column "A" needs to have a second click to start working after I have cleared it.
Can the code below be modified into my "clear" sub to revert a checked cell to blank, and leave the blank cells alone?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim CheckmarkCells As Range
Set CheckmarkCells = Range("A3:A1000")
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, CheckmarkCells) Is Nothing Then
If Target.Font.Name = "Marlett" Then
Target.ClearContents
Target.Font.Name = "Arial"
Target.Offset(0, 1).Select
Else
Target.Value = "a"
Target.Font.Name = "Marlett"
Target.Offset(0, 1).Select

End If
End If
End Sub

This is my cleardata sub:
Sub ClearData()

Sheets("Data").Select
Range("C3:AS999").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A3:A999").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("B3").Select
Sheets("Data").Select
End Sub

mdmackillop
07-19-2007, 12:11 AM
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim CheckmarkCells As Range
Set CheckmarkCells = Range("A3:A1000")
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, CheckmarkCells) Is Nothing Then
With Target
If .Font.Name = "Marlett" Or .Font.Name = "Arial" And .Value = "" Then
.Font.Name = "Marlett"
.Value = "a"
.Offset(0, 1).Select
Else
If .Font.Name = "Marlett" And .Value = "a" Then
.ClearContents
.Font.Name = "Arial"
.Offset(0, 1).Select
End If
End If
End With
End If
End Sub

Sub ClearData()
Application.EnableEvents = False
With Sheets("Data")
.Range("C3:AS" & Rows.Count).ClearContents
.Range("A3:A" & Rows.Count).ClearContents
End With
Application.EnableEvents = True
End Sub

mperrah
07-19-2007, 12:46 PM
Thanks mdmackillop,
once again you are the master,

That works great.

One more thing.
Is there a way to clear all the borders from K3 to AS3 and down
The form I print I add a border and when I clear it for the next week I have different numbers of rows and want to clear the borders as well, but not the borders above row 3...
Thank again.
Mark

Bob Phillips
07-19-2007, 01:46 PM
With Range("K3:AS" & Rows.Count)
.Borders(xlLeft).LineStyle = xlNone
.Borders(xlRight).LineStyle = xlNone
.Borders(xlTop).LineStyle = xlNone
.Borders(xlBottom).LineStyle = xlNone
End With

mperrah
07-19-2007, 03:36 PM
That did the trick for the borders too, thank you.

I was testing the cell change to add the check mark, that works.
The uncheck has stopped working though.

I tried to modify the code to get it to remove
and noticed if a cell had a check that was cleared it wont add a check with my alteration?

If .Font.Name = "Arial" Then 'testing this

'.Font.Name = "Marlett" Or .Font.Name = "Arial" And .Value = "" Then
.Font.Name = "Marlett"
.Value = "a"
.Offset(0, 1).Select
Else
If .Font.Name = "Marlett" And .Value = "a" Then
.ClearContents
.Font.Name = "Arial"
.Offset(0, 1).Select
End If

Also, how do you add a border when a cell has data in it within a certain range as in: Range("K3:AS" & Rows.Count)?

mperrah
07-19-2007, 03:57 PM
This change in the ClearData sub seems to work now keeping my alteration from post #5 in the sheet code

Sub ClearData()
Application.EnableEvents = False
With Sheets("Data")
.Range("C3:AS" & Rows.Count).ClearContents
.Range("A3:A" & Rows.Count).ClearContents
.Range("A3:A" & Rows.Count).Font.Name = "Arial"
.Range("K3:AS3").Select
.Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Application.EnableEvents = True
End Sub

I recorded this to add the borders, I now there is a way to use with to clean it up but not sure how to impliment the different border types.


Sub setBorders()
'
' setBorders Macro
'
Range("K3:AS22").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub


would this be close?
With Selection.Borders LineStyle = xlContinuous Weight = xlThin
.(xlInsideHorizontal)
.(xlInsideVertical)

End With

or would a case senario work?
I don't think the .(type) is the proper word order...

Maybe

with selection.borders(xlInsideHorizontal) and (xlInsideVertical) ' and etc...
.linestyle = xlcontinuous
.weight = xlthin
end with '?

geekgirlau
07-19-2007, 04:17 PM
I find borders pretty annoying for this reason, but one way to streamline your code is understanding what the default options are. With borders, by default they are thin and black, so unless you are changing the colour or weight of the border, you can use something like the following:


Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous

mperrah
07-19-2007, 08:14 PM
Awesome Girly,
That is much cleaner.
I just noticed all the repeated lines and though a "with" statement might fit in some how.
Your code is great... Thank you.
Mark

geekgirlau
07-19-2007, 09:25 PM
You could do "With Selection" ...

Norie
07-19-2007, 11:03 PM
Or you could lose Selection/Select altogether.:)

And even use this.

With Range("K3:AS22").Borders
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

mperrah
07-20-2007, 12:34 AM
I liked the idea from Norie and pulled from another sub and ot this to work.
It is a little slow, but it's kind of neat that I got it to work.
Thank you all for such awesome support.
Mark

Sub setBorders()
Dim BorderArea As Worksheet
Dim myRng As Range
Dim myCell As Range

Set BorderArea = Worksheets("Data")
With BorderArea
Set myRng = .Range("K3:AS3", .Cells(.Rows.Count, "K").End(xlUp))
End With

For Each myCell In myRng.Cells
With myCell.Borders
.LineStyle = xlContinuous
.Weight = xlThin
End With
Next myCell
End Sub

This stuff is starting to click for me :)

Norie
07-20-2007, 08:06 AM
Mark

Why the loop?


Sub setBorders()
Dim BorderArea As Worksheet
Dim myRng As Range
Dim myCell As Range

Set BorderArea = Worksheets("Data")
With BorderArea
Set myRng = .Range("K3:AS3", .Cells(.Rows.Count, "K").End(xlUp))
End With

With myRng.Borders
.LineStyle = xlContinuous
.Weight = xlThin
End With

End Sub

mperrah
07-20-2007, 12:47 PM
Norie,
Even better then I imagined...
I put the loop because I had the code and new it worked (just not how)
Your way is much quicker and code looks tighter too.
Thank you soo much!!
Mark

mperrah
07-20-2007, 12:52 PM
Here is what I ended up using to add and remove borders.
I put a command button on the sheet and assigned the macros.
It scans column "K" and goes across to column "AS"
any cell with data down column "K" gets a border added
and then removed after I print selected...
(can I make the same selection plus the top 2 rows go to a print selection with a button? - duh with VBA it's not can, it's how many ways do you want to try...)
Sub setBorders()
Dim BorderArea As Worksheet
Dim myRng As Range
Dim myCell As Range

Set BorderArea = Worksheets("Data")
With BorderArea
Set myRng = .Range("K3:AS3", .Cells(.Rows.Count, "K").End(xlUp))
End With

With myRng.Borders
.LineStyle = xlContinuous
.Weight = xlThin
End With

End Sub
Sub clearBorders()
With Sheets("Data")
.Range("K3:AS3").Select
.Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End Sub

geekgirlau
07-22-2007, 07:13 PM
Sub setBorders()
Dim BorderArea As Worksheet
Dim myRng As Range
Dim myCell As Range

Set BorderArea = Worksheets("Data")
With BorderArea
Set myRng = .Range("K3:AS3", .Cells(.Rows.Count, "K").End(xlUp))
End With

' "Thin" is the default weight, so don't need to set
myRng.Borders.LineStyle = xlContinuous
End Sub

mperrah
07-22-2007, 11:39 PM
I noticed that too...
This is what we came up with, I have one sub to add another to remove.
This might make a good knowledge base entry. GeekGirlAU gets the props.
I alwayse love hearing from you cause I love your avatar
Sub setBorders()
Dim BorderArea As Worksheet
Dim myRng As Range
Dim myCell As Range

Set BorderArea = Worksheets("Data")
With BorderArea
Set myRng = .Range("K3:AS3", .Cells(.Rows.Count, "K").End(xlUp))
End With

With myRng.Borders.LineStyle = xlContinuous
End With

End Sub
Sub remove_border()
Dim BorderArea As Worksheet
Dim myRng As Range
Dim myCell As Range

Set BorderArea = Worksheets("Data")
With BorderArea
Set myRng = .Range("K3:AS3", .Cells(.Rows.Count, "K").End(xlUp))
End With

With myRng.Borders.LineStyle = xlNone
End With
End Sub