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" <demechanik@yahoo.com> wrote in message
news:uOlFdj3MFHA.3340@TK2MSFTNGP14.phx.gbl...
> 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 <at>yahoo<dot>com
> ----
>
>

Thanks Bob ! Helluva fast response there ! <bg>

Ok, I found that the first run of the sub created the new sheet:
MergeCellData, but it was empty. When I ran the sub again, it worked fine,
writing the results in col A in MergeCellData.

How could the sub be further modified to create and name a new sheet,
say: MergeCellData_Sheet1 which bears relevance to the sheet (Sheet1) with
merged cells, and doesn't need a re-run to write the results there? And if I
then run the sub on another sheet with merged cells, Sheet2 (say), it'll do
similarly, i.e. create MergeCellData_Sheet2 with the results for Sheet2?

Thanks
--
Rgds
Max
xl 97
---
GMT+8, 1° 22' N 103° 45' E
xdemechanik <at>yahoo<dot>com
----

"Max" <demechanik@yahoo.com> wrote in message
news:eIYc0D4MFHA.1308@TK2MSFTNGP15.phx.gbl...
>
> Ok, I found that the first run of the sub created the new sheet:
> MergeCellData, but it was empty. When I ran the sub again, it worked
fine,
> writing the results in col A in MergeCellData.

Oft made mistake (by me). Creating a new sheet activates it, and I don't
reset.

> How could the sub be further modified to create and name a new sheet,
> say: MergeCellData_Sheet1 which bears relevance to the sheet (Sheet1) with
> merged cells, and doesn't need a re-run to write the results there? And if
I
> then run the sub on another sheet with merged cells, Sheet2 (say), it'll
do
> similarly, i.e. create MergeCellData_Sheet2 with the results for Sheet2?

This creates as requested, then activates the new sheet

Option Explicit

Sub testme02()
Const kSheet = "MergeCellData"
Dim sSheet As String
Dim myCell As Range
Dim resp As Long
Dim thisSheet As Worksheet
Dim sh As Worksheet
Dim i As Long

sSheet = kSheet & "_" & ActiveSheet.Name
Set thisSheet = ActiveSheet
On Error Resume Next
Set sh = Worksheets(sSheet)
On Error GoTo 0
If sh Is Nothing Then
Set sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
sh.Name = sSheet
thisSheet.Activate
Else
sh.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

sh.Activate

End Sub

"Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote
.....
> Oft made mistake (by me)....
Aha, gotcha ! <bg>

> This creates as requested, then activates the new sheet
Terrific, it runs *great* !
Many thanks, Bob
--
Rgds
Max
xl 97
---
GMT+8, 1° 22' N 103° 45' E
xdemechanik <at>yahoo<dot>com
----