Jumat, 03 Juni 2011

[ExcelVBA] Re: Clearing the cells that have no links to them.

 

The following macro (trial it on a copy of your workbook) will highlight two areas on the active sheet when run. Those cells which you say you want to keep (be careful and read what David Braithwaite said about deleting cells you may not really want to delete) will be highlighted by formatting with a diagonal line, and those that you want to keep with a light green fill.

That way you don't lose your data you might want to keep. If this turns out nevertheless to be really what you want then you can uncomment the line:
'CellsToClear.ClearContents
below, and delete the lines:

'now fill with light green cells to keep:
With CellsToKeep.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With

as wellas deleting:

'now put diagonal line through deletion candidates:
With CellsToClear.Borders(xlDiagonalUp)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

Anyway, the macro for initial trials is:

Sub blah()
Dim CellsToKeep As Range
Dim CellsToClear As Range
Set asht = ActiveSheet
For Each cll In asht.UsedRange.Cells
With cll
.ShowDependents
.NavigateArrow False, 1
If Selection.Address(external:=True) <> _
.Address(external:=True) Then
.ShowDependents Remove:=True
If CellsToKeep Is Nothing Then Set _
CellsToKeep = cll Else Set CellsToKeep _
= Union(CellsToKeep, cll)
End If
End With
Next cll
'now fill with light green cells to keep:
With CellsToKeep.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With

'Application.Goto CellsToKeep
For Each cll In asht.UsedRange.Cells
If Intersect(cll, CellsToKeep) Is Nothing Then
If CellsToClear Is Nothing Then _
Set CellsToClear = cll Else _
Set CellsToClear = Union(CellsToClear, cll)
End If
Next cll
'now put diagonal line through deletion candidates:
With CellsToClear.Borders(xlDiagonalUp)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
'Application.Goto CellsToClear
'CellsToClear.ClearContents
End Sub

--- In ExcelVBA@yahoogroups.com, Lipa Roitman <lipa.roitman@...> wrote:
>
> The references are from the different sheets in the same workbook.
>
> --
> Lipa Roitman
>

__._,_.___
Recent Activity:
----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA

----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com

----------------------------------
.

__,_._,___

Tidak ada komentar:

Posting Komentar