How to use .find with mergearea

chakalido

New Member
Joined
Jul 18, 2014
Messages
16
Hello everyone, I am working on this part of a big code and I am having issues with using .find with mergeArea as I cannot pull out the information and add it into a new sheet. Actually this part of the code can read the value in merged cells (I did an inspection) but it does not pull them out. How can I do this? I would thank very much any help.

Code:
<code> For Each ws In SourceWb.Worksheets   
If IsNumeric(Left(ws.name, 3)) Then  Set gCell = ws.Columns("F").Find(what:=numdoc, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, searchformat:=False)  
    If Not gCell Is Nothing Then
     <code>[COLOR=#000000]firstAddress = gCell.Address  
     contador = contador + 1  
      ColorIndexOfCF = gCell.Interior.ColorIndex 
        Do [/COLOR][COLOR=#FF0000]    
         contactos = gCell.Offset(, 4).MergeArea.Value     
         comentarios= gCell.Offset(, 5).MergeArea.Value      
        If IsDate(HojaActiva.Cells(F1, 5).Value) = True Then 
          HojaNueva.Rows(F2).Interior.ColorIndex = ColorIndexOfCF     
        End If      [/COLOR][COLOR=#000000] 
[/COLOR][COLOR=#00ff00]'busca si el valor está repetido y si lo está lo copia seguidamente del comentario    [/COLOR][COLOR=#000000]
        If Not contactos = "" Then          
          HojaNueva.Cells(F2, 20).Value = contactos & " ," & HojaNueva.Cells(F2, 20).Value     
        End If     
        If Not comentarios = "" Then        
           HojaNueva.Cells(F2, 21).Value = comentarios & " ," & HojaNueva.Cells(F2, 21).Value     
        End If     
        Set gCell = ws.Columns("F").FindNext(gCell)   
 Loop While Not gCell Is Nothing And gCell.Address <> firstAddress  End If  End If  Next ws  Set gCell = Nothing [/COLOR]</code></code>
 
Last edited:

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
I added a line to set a new range variable equal to gCell.Offset(, 4).MergeArea with a succeeding Stop line then examined the new variable's properties in the Locals window. It looks as if the following will give you the value you want:
Code:
contactos = gCell.Offset(, 4).MergeArea.Value2(1, 1)
comentarios = gCell.Offset(, 5).MergeArea.Value2(1, 1)

There is no .Value property for a merged area
 
Upvote 0
I added a line to set a new range variable equal to gCell.Offset(, 4).MergeArea with a succeeding Stop line then examined the new variable's properties in the Locals window. It looks as if the following will give you the value you want:
Code:
contactos = gCell.Offset(, 4).MergeArea.Value2(1, 1)
comentarios = gCell.Offset(, 5).MergeArea.Value2(1, 1)

There is no .Value property for a merged area

Now it only takes the merged values lol
I'm just going to repeat again the code but without mergearea and and just join them.
Thank you very much though, didn't know about .value2
Have a nice day,

Cheers
 
Upvote 0
I've been testing and it doesn't work for all either my solution and your solution. There might be something in between that solves our problem. maybe .text?
 
Upvote 0
Perhaps something like this:
Code:
                If gcell.Offset(, 4).MergeArea.Address = gcell.Offset(, 4).Address Then
                    'Not a merged cell
                    contactos = gcell.Offset(, 4).Value
                    comentarios = gcell.Offset(, 5).Value
                Else
                    'is a merged cell
                    contactos = gcell.Offset(, 4).MergeArea.Value2(1, 1)
                    comentarios = gcell.Offset(, 5).MergeArea.Value2(1, 1)
                End If
 
Upvote 0
Perhaps something like this:
Code:
                If gcell.Offset(, 4).MergeArea.Address = gcell.Offset(, 4).Address Then
                    'Not a merged cell
                    contactos = gcell.Offset(, 4).Value
                    comentarios = gcell.Offset(, 5).Value
                Else
                    'is a merged cell
                    contactos = gcell.Offset(, 4).MergeArea.Value2(1, 1)
                    comentarios = gcell.Offset(, 5).MergeArea.Value2(1, 1)
                End If
Thank you for your answer,
I did something similar but it worked only sometimes, (Still dont know why). An other strategy could be unmerging the cells from the column and copying the values over the unmerged cells, like this it should work for sure?
I will try your piece of code to see what happens but got not many hope about it. I will keep you updated, Thank you very much.
 
Upvote 0
How is your data laid out that sometimes the cells are merged and sometimes not? Please use Excel Jeanie (see my sig) to post a portion of your data that shows this situation.
 
Upvote 0
as you see the code is looking for data in a secondary sheet, taking as refference a determined value of the first sheet, some results have coments and contacts attached (mix between numbers and letters) and in some cases they are shared by more than one refference (so cells are merged), but in other cases they do not apear or do not have any coment or contact. They are all in one respective column each and divided through sheets (we only need to take some specific sheets and this part of the code allredy works well). A same reference can be repeated through these sheets and the code manages (Tries) to take and add one after the other the different values across the sheets.
it is accounting information so I cannot post a real sample of it here (I would breach the privacy contract I signed) But I will post a sample of this data soon.
Thank you very much,

Dani
 
Upvote 0
Unfortunately I am trying to use Jeania but it doesnt work even if I did all the instructions (might be an administrator issue) what we can do is that here I give you my email, you can send an email and I will send the two workbooks to you.
danivillagol@gmail.com
Thank you very much
 
Upvote 0
I used this piece of code and it did not work.
Code:
 For Each ws In SourceWb.Worksheets
                            If IsNumeric(Left(ws.name, 3)) Then Set gCell = ws.Columns("F").Find(what:=numdoc, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, searchformat:=False)
                                If Not gCell Is Nothing Then
                                    contactos = ""
                                    comentarios = ""
                                    contactos2 = ""
                                    comentarios2 = ""
                                    firstAddress = gCell.Address
                                    contador = contador + 1
                                    ColorIndexOfCF = gCell.Interior.ColorIndex
                                 Do
                                    If gCell.Offset(, 4).MergeArea.Address = gCell.Offset(, 4).Address Then
                                     'Not a merged cell
                                     contactos = gCell.Offset(, 4).Value
                                     comentarios = gCell.Offset(, 5).Value
                                    Else
                                      'is a merged cell
                                      contactos = gCell.Offset(, 4).MergeArea.Value2(1, 1)
                                      comentarios = gCell.Offset(, 5).MergeArea.Value2(1, 1)
                                    End If
                                    If IsDate(HojaActiva.Cells(F1, 5).Value) = True Then
                                    HojaNueva.Rows(F2).Interior.ColorIndex = ColorIndexOfCF
                                     End If
                                     
                                    'busca si el valor está repetido y si lo está lo copia seguidamente del contenido anterior de la celda (a veces se repite pero los saca todos)
                                         contactos2 = HojaNueva.Cells(F2, 20).Value
                                         comentarios2 = HojaNueva.Cells(F2, 21).Value
                                     
                                            If InStr(1, contactos2, contactos) = 0 And Not contactos Is Nothing Then
                                                HojaNueva.Cells(F2, 20).Value = contactos & " ," & contactos2
                                            End If
                                            If InStr(1, comentarios2, comentarios) = 0 And Not comentarios Is Nothing Then
                                                HojaNueva.Cells(F2, 21).Value = comentarios & " ," & comentarios2
                                            End If
                                            Set gCell = ws.Columns("F").FindNext(gCell)
                                            Loop While Not gCell Is Nothing And gCell.Address <> firstAddress
                                         End If
                                        Next ws
 
Upvote 0

Forum statistics

Threads
1,222,830
Messages
6,168,507
Members
452,194
Latest member
Lowie27

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top