Modify sub to output to new sheet instead of via msg boxes

  • Thread starter Thread starter Max
  • Start date Start date
M

Max

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
 
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)
 
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
 
Max said:
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.
Click to expand...

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?
Click to expand...

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
 
Back
Top