ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Modify sub to output to new sheet instead of via msg boxes (https://www.excelbanter.com/excel-programming/326268-modify-sub-output-new-sheet-instead-via-msg-boxes.html)

Max

Modify sub to output to new sheet instead of via msg boxes
 
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
----



Bob Phillips[_6_]

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





Max

Modify sub to output to new sheet instead of via msg boxes
 
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 <atyahoo<dotcom
----



Bob Phillips[_6_]

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

"Max" wrote in message
...

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





Max

Modify sub to output to new sheet instead of via msg boxes
 
"Bob Phillips" 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 <atyahoo<dotcom
----




All times are GMT +1. The time now is 06:29 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com