Modify sub to output to new sheet instead of via msg boxes
Hi Max,
Here is one way
Option Explicit
Sub testme02()
Const kSheet = "MergeCellData"
Dim myCell As Range
Dim resp As Long
Dim sh As Worksheet
Dim i As Long
On Error Resume Next
Set sh = Worksheets(kSheet)
On Error GoTo 0
If sh Is Nothing Then
Set sh = Worksheets.Add(after:=Worksheets(Worksheets.Count) )
sh.Name = kSheet
Else
Worksheets(kSheet).Cells.ClearContents
End If
For Each myCell In ActiveSheet.UsedRange
If myCell.MergeCells = True Then
If myCell.Address = myCell.MergeArea.Cells(1, 1).Address Then
i = i + 1
sh.Cells(i, "A").Value = "found at: " _
& myCell.Address(0, 0) & " Of " _
& myCell.MergeArea.Address(0, 0)
End If
End If
Next myCell
End Sub
--
HTH
RP
(remove nothere from the email address if mailing direct)
"Max" wrote in message
...
Hi guys,
Just wondering if/how could Dave P's Sub testme02() - pasted below - be
modified to output all findings of the merged cells to a new sheet (in col
A, say) instead of via msg boxes ? Would be easier to refer .. Thanks.
---- From a Dave P's post in .misc -------------
"Manually, you could divide and conquer. Select half the range, hit
ctrl-1
(to show the Format|Cell dialog). Look at that Alignment tab and look at
the Merge cells box. If it's not checked, look in the other half. If it's
a
black check mark, you found it. If it's a grey check mark, you're getting
warmer--it's in the selected range.
Here's one way via a macro that looks at all the cells
in the usedrange:
Option Explicit
Sub testme02()
Dim myCell As Range
Dim resp As Long
For Each myCell In ActiveSheet.UsedRange
If myCell.MergeCells = True Then
If myCell.Address = myCell.MergeArea.Cells(1, 1).Address Then
resp = MsgBox(Prompt:="found at: " _
& myCell.Address(0, 0) & " Of " _
& myCell.MergeArea.Address(0, 0), _
Title:="Continue Looking?", _
Buttons:=vbYesNo)
If resp = vbNo Then
Exit Sub
End If
End If
End If
Next myCell
End Sub
--
Rgds
Max
xl 97
---
GMT+8, 1° 22' N 103° 45' E
xdemechanik <atyahoo<dotcom
----
|