Count value when the value is a merged cell

[Macaron]

Hello, I'm a newbie to type VBA code.
Recently, I would like to create a series of VBA code in order to accelerate work.
Now, I have faced the problems below:
1. I would like to count the number of "LTG" which has 3 merged rows only.(shown in the uploaded image)
2. About the Find Function, I discovered that when "Remark" has merged 2 columns,
Find Function didn't work, so I have to find "*" or unmerged "Remark" columns. Is there any ways I can find the range of Remark columns within border area. I just want to the range which is below "Remark"(Range("X11")) to last row with border area(Range("X42")).

Sub Countnumber()
    Dim objNewWorkbook As Workbook
    Dim objNewWorksheet As Worksheet
    Dim LastColumn As Long
    Set objNewWorkbook = Excel.Application.Workbooks.Add
    Set objNewWorksheet = objNewWorkbook.Sheets(1)
    
    For i = 1 To ThisWorkbook.Sheets.Count
    objNewWorksheet.Cells(i, 1) = ThisWorkbook.Sheets(i).Name
    LastColumn = ThisWorkbook.Sheets(i).Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    objNewWorksheet.Cells(i, 6).Value = WorksheetFunction.CountIf(ThisWorkbook.Sheets(i).Columns(LastColumn), "*LTG*")
    
    Next i
End Sub

Hope someone can help me..

 

[Alex Blakenburg]

I am not really clear on what you are trying to achieve.
This will count all cells that contain LTG and consist of merged cells convering 3 rows.

Sub FindMergedCells()

    Dim cntOccurence As Long
    Dim sht As Worksheet
    Dim wb As Workbook
    Dim rng As Range
    Dim foundCell As Range
    Dim strToFind As String
    Dim FirstAddr As String
   
    Set wb = ThisWorkbook
    Set sht = wb.ActiveSheet
    Set rng = sht.Range("A:A")
    cntOccurence = 0
    strToFind = "LTG"

    With Application.FindFormat
        .WrapText = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
   
   
    Set foundCell = rng.Find(What:="", After:=rng.Cells(1, 1), LookIn:=xlFormulas2, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True)
       

    If Not foundCell Is Nothing Then
        FirstAddr = foundCell.Address
    End If
   
    Do Until foundCell Is Nothing
        If foundCell.MergeArea.Rows.Count = 3 And InStr(foundCell.Value, strToFind) > 0 Then
                cntOccurence = cntOccurence + 1
        End If
       
        ' FindNext didn't seem to work for merged cells
        ' Set foundCell = rng.FindNext(After:=foundCell)
        Set foundCell = rng.Find(What:="", After:=foundCell, LookIn:=xlFormulas2, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=True)
        If foundCell.Address = FirstAddr Then
            Exit Do
        End If
    Loop
   
    MsgBox "No of Occurences: " & cntOccurence

End Sub

 

[Macaron]

I am not really clear on what you are trying to achieve.
This will count all cells that contain LTG and consist of merged cells convering 3 rows.

Sub FindMergedCells()

    Dim cntOccurence As Long
    Dim sht As Worksheet
    Dim wb As Workbook
    Dim rng As Range
    Dim foundCell As Range
    Dim strToFind As String
    Dim FirstAddr As String
  
    Set wb = ThisWorkbook
    Set sht = wb.ActiveSheet
    Set rng = sht.Range("A:A")
    cntOccurence = 0
    strToFind = "LTG"

    With Application.FindFormat
        .WrapText = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
  
  
    Set foundCell = rng.Find(What:="", After:=rng.Cells(1, 1), LookIn:=xlFormulas2, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True)
      

    If Not foundCell Is Nothing Then
        FirstAddr = foundCell.Address
    End If
  
    Do Until foundCell Is Nothing
        If foundCell.MergeArea.Rows.Count = 3 And InStr(foundCell.Value, strToFind) > 0 Then
                cntOccurence = cntOccurence + 1
        End If
      
        ' FindNext didn't seem to work for merged cells
        ' Set foundCell = rng.FindNext(After:=foundCell)
        Set foundCell = rng.Find(What:="", After:=foundCell, LookIn:=xlFormulas2, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=True)
        If foundCell.Address = FirstAddr Then
            Exit Do
        End If
    Loop
  
    MsgBox "No of Occurences: " & cntOccurence

End Sub

Thanks for your reply. Sorry for my bad expression.
I tried your code. It showed"Application-defined or object-defined error" in this code.

  Set foundCell = rng.Find(What:="", After:=rng.Cells(1, 1), LookIn:=xlFormulas2, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True)

Could you explain

   cntOccurence = cntOccurence + 1

Purpose of code:
The whole sheet is below, I am going to write code according to this sheet.
To what I want to achieve is count the data . Count LTG which has merged and non-merged separately. (I haven't done this part of code yet)
Finally, I will output the count number in new sheet( I have done this part of code)

Coding Test.xls
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X
1
2	Contract No. :
3	W.O. No. :
4	Location :
5	Description :
6
7
8
9
10
11	Circuit No. :																							Remark
12
13	1																							LTG
14	1
15	1
16	2																							LTG
17	2																							SPARE
18	2																							SPARE
19	3																							32A LTG
20	3
21	3
22	4																							LTG
23	4																							SPARE
24	4																							SPARE
25	5																							100A LTG
26	5
27	5
28	6																							10A LTG
29	6
30	6
31	7																							100A LTG
32	7
33	7
34	8																							10A LTG
35	8																							11A LTG
36	8																							12A LTG
37
38
39	Tested By :										Checked By :										Equipment :
40	Testing Date :										Date :										Brand :
41	R.E.W. No. :																				Model No. :
42																					Cert. No. :
43																					Calibration Cert. Date :
1L-GF

 

[Alex Blakenburg]

See if this does what you need. I am now only looking in column X.

Sub FindMergedCells()

    Dim cntMerged As Long
    Dim cntNotMerged As Long
    Dim sht As Worksheet
    Dim wb As Workbook
    Dim rng As Range
    Dim foundCell As Range
    Dim strToFind As String
    Dim FirstAddr As String
   
    Set wb = ThisWorkbook
    Set sht = wb.ActiveSheet
    Set rng = sht.Range("X:X")
    cntMerged = 0
    cntNotMerged = 0
    strToFind = "LTG"
     
    Set foundCell = rng.Find(What:=strToFind, After:=rng.Cells(1, 1), LookIn:=xlFormulas2, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True)
       
    If Not foundCell Is Nothing Then
        FirstAddr = foundCell.Address
    End If
   
    Do Until foundCell Is Nothing
        If foundCell.MergeArea.Rows.Count > 1 Then
                cntMerged = cntMerged + 1
        Else
                cntNotMerged = cntNotMerged + 1
        End If
       

        Set foundCell = rng.FindNext(After:=foundCell)

        If foundCell.Address = FirstAddr Then
            Exit Do
        End If
    Loop
   
    MsgBox "No of Merged: " & cntMerged & vbLf & _
                "No of Not Merged: " & cntNotMerged

End Sub

 

[Macaron]

See if this does what you need. I am now only looking in column X.

Sub FindMergedCells()

    Dim cntMerged As Long
    Dim cntNotMerged As Long
    Dim sht As Worksheet
    Dim wb As Workbook
    Dim rng As Range
    Dim foundCell As Range
    Dim strToFind As String
    Dim FirstAddr As String
  
    Set wb = ThisWorkbook
    Set sht = wb.ActiveSheet
    Set rng = sht.Range("X:X")
    cntMerged = 0
    cntNotMerged = 0
    strToFind = "LTG"
    
    Set foundCell = rng.Find(What:=strToFind, After:=rng.Cells(1, 1), LookIn:=xlFormulas2, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True)
      
    If Not foundCell Is Nothing Then
        FirstAddr = foundCell.Address
    End If
  
    Do Until foundCell Is Nothing
        If foundCell.MergeArea.Rows.Count > 1 Then
                cntMerged = cntMerged + 1
        Else
                cntNotMerged = cntNotMerged + 1
        End If
      

        Set foundCell = rng.FindNext(After:=foundCell)

        If foundCell.Address = FirstAddr Then
            Exit Do
        End If
    Loop
  
    MsgBox "No of Merged: " & cntMerged & vbLf & _
                "No of Not Merged: " & cntNotMerged

End Sub

I think your code is what I want, thanks for your help.
But it still have the same error on this code.

   Set foundCell = rng.Find(What:=strToFind, After:=rng.Cells(1, 1), LookIn:=xlFormulas2, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True)

 

[Alex Blakenburg]

But it still have the same error on this code.

Can you try changing the last parameter to False, since it is no longer looking specifically for "Merged" cells.

SearchFormat:=False)

 

[Macaron]

Can you try changing the last parameter to False, since it is no longer looking specifically for "Merged" cells.

SearchFormat:=False)

it still has the same error. I think that it may related to the version of Excel.

SearchFormat:=False)

 

[Macaron]

Can you try changing the last parameter to False, since it is no longer looking specifically for "Merged" cells.

SearchFormat:=False)

I changed LookIn:=xlFormulas2 to LookIn:=xlFormulas. Finally, it is work!!
So, I do think that it is related to version.
Could you explain what is difference between xlFormulas2 and xlFormulas?

Could you explain why the cntMerged =0 and cntMerged +1, I don't understand. Sorry for disturbance

cntMerged = cntMerged + 1

All in all, thanks for your help!

 

[Alex Blakenburg]

1) xlFormulas2

Could you explain what is difference between xlFormulas2 and xlFormulas?

To be honest I just recorded the original find for Format > Merged cells and that is what the recorder used.
I have done some checking and it doesn't look like anyone really has a handle on it and it is an "undocumented" feature.

Apparently it only works on a machine that supports dynamic arrays which means MS 365, which is why it errors out on your machine and you needed to change it back to xlFormulas


2) cntMerged = cntMerged + 1

Could you explain why the cntMerged =0 and cntMerged +1,

I have 2 counters based on your requirement below that you wanted to count merged and non-merged cells separately.

Count LTG which has merged and non-merged separately

They are first both set to an initial value of 0.

    cntMerged = 0
    cntNotMerged = 0

Then each time LTG is found an if statement determines whether it is in a merged cell or not on the appropriate counter is inceremented by 1.

cntMerged = cntMerged + 1
cntNotMerged = cntNotMerged + 1

Let me know if I haven't explained it properly or you have other questions.

 

[Macaron]

1) xlFormulas2

To be honest I just recorded the original find for Format > Merged cells and that is what the recorder used.
I have done some checking and it doesn't look like anyone really has a handle on it and it is an "undocumented" feature.

Apparently it only works on a machine that supports dynamic arrays which means MS 365, which is why it errors out on your machine and you needed to change it back to xlFormulas


2) cntMerged = cntMerged + 1

I have 2 counters based on your requirement below that you wanted to count merged and non-merged cells separately.

They are first both set to an initial value of 0.

    cntMerged = 0
    cntNotMerged = 0

Then each time LTG is found an if statement determines whether it is in a merged cell or not on the appropriate counter is inceremented by 1.

cntMerged = cntMerged + 1
cntNotMerged = cntNotMerged + 1

Let me know if I haven't explained it properly or you have other questions.

Thanks! Does it show error in VBA code, when Find formula can’t find the “foundcell”? I got trouble in here