VBA merge cells in another column based on already merged cells. Possible?

S

SwanB

New Member
Joined
Aug 31, 2023
Messages
10
Office Version
  1. 365
Platform
  1. Windows
Hello. Is it possible to merge cells in a column based on already merged cells from another column? I have a column that has merged cells using the code below. I now want to merge the columns next to this column to group the merged cells.
Column H is run by the code below. I want to also merge cells in Column F and G that match the same merge as column H. The merge needs to be based off of column H though.
Any help is much appreciated.

This is what it looks like now:
1701268560549.png


This is what I want it to look like:

1701268720790.png


Code for merging Comps:
Sub MergeSameCells()

Application.DisplayAlerts = False

Dim rng As Range

MergeCells:

For Each rng In Selection
If rng.Value = rng.Offset(1, 0).Value And rng.Value <> "" Then
Range(rng, rng.Offset(1, 0)).Merge
Range(rng, rng.Offset(1, 0)).HorizontalAlignment = xlCenter
Range(rng, rng.Offset(1, 0)).VerticalAlignment = xlCenter
GoTo MergeCells
End If

Next

End Sub


lookup.xlsx
FGH
1Pulp_Composite_for_MEME_Analysis_CodeNew_Composite_Sample_ID
2DO NOT INCLUDE IN COMPOSITEDO NOT INCLUDE IN COMPOSITEDO NOT USE IN COMPOSITE
3Composite Pulp for MEME-MS41MZ22-01_0-20_COMP
4Composite Pulp for MEME-MS41
5Composite Pulp for MEME-MS41
6Composite Pulp for MEME-MS41
7Composite Pulp for MEME-MS41MZ22-01_20-40_COMP
8Composite Pulp for MEME-MS41
9Composite Pulp for MEME-MS41
10Composite Pulp for MEME-MS41
11Composite Pulp for MEME-MS41MZ22-01_40-55_COMP
12Composite Pulp for MEME-MS41
13DO NOT INCLUDE IN COMPOSITEDO NOT INCLUDE IN COMPOSITEDO NOT USE IN COMPOSITE
14Composite Pulp for MEME-MS41MZ22-01_40-55_COMP
15Composite Pulp for MEME-MS41MZ22-01_55-70_COMP
16Composite Pulp for MEME-MS41
17Composite Pulp for MEME-MS41
18Composite Pulp for MEME-MS41MZ22-01_70-85_COMP
19Composite Pulp for MEME-MS41
20Composite Pulp for MEME-MS41
21Composite Pulp for MEME-MS41MZ22-01_85-100_COMP
22Composite Pulp for MEME-MS41
23Composite Pulp for MEME-MS41
24DO NOT INCLUDE IN COMPOSITEDO NOT INCLUDE IN COMPOSITEDO NOT USE IN COMPOSITE
25Composite Pulp for MEME-MS41MZ22-01_100-120_COMP
26Composite Pulp for MEME-MS41
27Composite Pulp for MEME-MS41
28Composite Pulp for MEME-MS41
29Composite Pulp for MEME-MS42MZ22-01_120-140_COMP
30Composite Pulp for MEME-MS43
31Composite Pulp for MEME-MS44
32Composite Pulp for MEME-MS45
Sheet1
Cell Formulas
RangeFormula
H2,H24,H13H2=IFERROR(XLOOKUP(SUBSTITUTE(RIGHT(A2,LEN(A2)-FIND("_",A2)),"-",".")*1,SUBSTITUTE(RIGHT('[Britt Test Sample Submittal GF (version 1).xlsb1.xlsm]Composites'!M:M,LEN('[Britt Test Sample Submittal GF (version 1).xlsb1.xlsm]Composites'!M:M)-FIND("_",'[Britt Test Sample Submittal GF (version 1).xlsb1.xlsm]Composites'!M:M)),"-",".")*1,'[Britt Test Sample Submittal GF (version 1).xlsb1.xlsm]Composites'!E:E,"DO NOT USE IN COMPOSITE",-1),"DO NOT USE IN COMPOSITE")
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Sort by date Sort by votes
SwanB said:
Hello. Is it possible to merge cells in a column based on already merged cells from another column? I have a column that has merged cells using the code below. I now want to merge the columns next to this column to group the merged cells.
Column H is run by the code below. I want to also merge cells in Column F and G that match the same merge as column H. The merge needs to be based off of column H though.
Any help is much appreciated.

This is what it looks like now:
View attachment 102671

This is what I want it to look like:

View attachment 102674

Code for merging Comps:
Sub MergeSameCells()

Application.DisplayAlerts = False

Dim rng As Range

MergeCells:

For Each rng In Selection
If rng.Value = rng.Offset(1, 0).Value And rng.Value <> "" Then
Range(rng, rng.Offset(1, 0)).Merge
Range(rng, rng.Offset(1, 0)).HorizontalAlignment = xlCenter
Range(rng, rng.Offset(1, 0)).VerticalAlignment = xlCenter
GoTo MergeCells
End If

Next

End Sub


lookup.xlsx
FGH
1Pulp_Composite_for_MEME_Analysis_CodeNew_Composite_Sample_ID
2DO NOT INCLUDE IN COMPOSITEDO NOT INCLUDE IN COMPOSITEDO NOT USE IN COMPOSITE
3Composite Pulp for MEME-MS41MZ22-01_0-20_COMP
4Composite Pulp for MEME-MS41
5Composite Pulp for MEME-MS41
6Composite Pulp for MEME-MS41
7Composite Pulp for MEME-MS41MZ22-01_20-40_COMP
8Composite Pulp for MEME-MS41
9Composite Pulp for MEME-MS41
10Composite Pulp for MEME-MS41
11Composite Pulp for MEME-MS41MZ22-01_40-55_COMP
12Composite Pulp for MEME-MS41
13DO NOT INCLUDE IN COMPOSITEDO NOT INCLUDE IN COMPOSITEDO NOT USE IN COMPOSITE
14Composite Pulp for MEME-MS41MZ22-01_40-55_COMP
15Composite Pulp for MEME-MS41MZ22-01_55-70_COMP
16Composite Pulp for MEME-MS41
17Composite Pulp for MEME-MS41
18Composite Pulp for MEME-MS41MZ22-01_70-85_COMP
19Composite Pulp for MEME-MS41
20Composite Pulp for MEME-MS41
21Composite Pulp for MEME-MS41MZ22-01_85-100_COMP
22Composite Pulp for MEME-MS41
23Composite Pulp for MEME-MS41
24DO NOT INCLUDE IN COMPOSITEDO NOT INCLUDE IN COMPOSITEDO NOT USE IN COMPOSITE
25Composite Pulp for MEME-MS41MZ22-01_100-120_COMP
26Composite Pulp for MEME-MS41
27Composite Pulp for MEME-MS41
28Composite Pulp for MEME-MS41
29Composite Pulp for MEME-MS42MZ22-01_120-140_COMP
30Composite Pulp for MEME-MS43
31Composite Pulp for MEME-MS44
32Composite Pulp for MEME-MS45
Sheet1
Cell Formulas
RangeFormula
H2,H24,H13H2=IFERROR(XLOOKUP(SUBSTITUTE(RIGHT(A2,LEN(A2)-FIND("_",A2)),"-",".")*1,SUBSTITUTE(RIGHT('[Britt Test Sample Submittal GF (version 1).xlsb1.xlsm]Composites'!M:M,LEN('[Britt Test Sample Submittal GF (version 1).xlsb1.xlsm]Composites'!M:M)-FIND("_",'[Britt Test Sample Submittal GF (version 1).xlsb1.xlsm]Composites'!M:M)),"-",".")*1,'[Britt Test Sample Submittal GF (version 1).xlsb1.xlsm]Composites'!E:E,"DO NOT USE IN COMPOSITE",-1),"DO NOT USE IN COMPOSITE")
Click to expand...
Did macro you used above really work well? i think it will go to infinity loop so i create this macro:
VBA Code: 
Sub MergeSameCells()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim rng As Range, mRng As Range
    Dim xStr As String
    Dim lr As Long
    lr = Range("H" & Rows.Count).End(xlUp).Row
    For Each rng In Range("H1:H" & lr)
        If Not IsEmpty(rng) Then
            If mRng Is Nothing Then
                Set mRng = rng
                xStr = rng.Value
            End If
            If rng.Value = xStr Then
                Set mRng = Union(mRng, rng)
                If rng.Row = lr Then GoTo LASTLOOP
            Else
LASTLOOP:
                With mRng
                    .Offset(, -1).Merge
                    .Offset(, -2).Merge
                    .Merge
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Offset(, -1).HorizontalAlignment = xlCenter
                    .Offset(, -1).VerticalAlignment = xlCenter
                    .Offset(, -2).HorizontalAlignment = xlCenter
                    .Offset(, -2).VerticalAlignment = xlCenter
                End With
                Set mRng = rng
                xStr = rng.Value
            End If
        End If
    Next rng
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

beside, i saw that 4 rows in 29 to 32 has different value in column G, it you merge it, it just keep value in G29
 
Upvote 0
Solution
eiloken said:
Did macro you used above really work well? i think it will go to infinity loop so i create this macro:
VBA Code: 
Sub MergeSameCells()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim rng As Range, mRng As Range
    Dim xStr As String
    Dim lr As Long
    lr = Range("H" & Rows.Count).End(xlUp).Row
    For Each rng In Range("H1:H" & lr)
        If Not IsEmpty(rng) Then
            If mRng Is Nothing Then
                Set mRng = rng
                xStr = rng.Value
            End If
            If rng.Value = xStr Then
                Set mRng = Union(mRng, rng)
                If rng.Row = lr Then GoTo LASTLOOP
            Else
LASTLOOP:
                With mRng
                    .Offset(, -1).Merge
                    .Offset(, -2).Merge
                    .Merge
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Offset(, -1).HorizontalAlignment = xlCenter
                    .Offset(, -1).VerticalAlignment = xlCenter
                    .Offset(, -2).HorizontalAlignment = xlCenter
                    .Offset(, -2).VerticalAlignment = xlCenter
                End With
                Set mRng = rng
                xStr = rng.Value
            End If
        End If
    Next rng
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

beside, i saw that 4 rows in 29 to 32 has different value in column G, it you merge it, it just keep value in G29
Click to expand...
Thank you! This code is exactly what I was needing. Thanks for looking into this for me and helping me out! Much appreciated!
 
Upvote 0
You must log in or register to reply here.

Similar threads

Z
  • Solved
VBA: ClearNotes in another Table
Replies
1
Views
121
zero269
Z
C
  • Solved
Merge based on Merged area of adjacent columns
Replies
2
Views
1K
CodeNewb
C
K
  • Solved
VBA Merge cells in range
Replies
3
Views
2K
Kra
K
A
  • Solved
VBA to list all links (external links AND hyperlinks) together with the cells containing the links
Replies
3
Views
1K
pbornemeier
pbornemeier
D
  • Question Question
Merging cells based on the merging in another column and SUM them up
Replies
1
Views
620
Kerryx
K

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

Share this page

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