Excel - Loop thru cells and Merge 1

[Andrzejek]

I have a report in Excel where I would like to Merge cells (that's what users want, so be it) So basically the outcome would be something like this (Merge 2 cells for 12 months in a Year)

[pre]
A B C D E F G H
1 | | | | | | | |
2 xxxxxxxx | yyyyyyy | zzzzzzz |

http://wwwwwwww

|
3 | | | | | | | |
[/PRE]
I know I can do:[tt]
Range("A2:B2").Merge
Range("C22").Merge
Range("E2:F2").Merge
...
[/tt]
but that's very tedious. I would rather loop thru cells across and Merge them in the loop.

Any ideas of how to do it?

Have fun.

---- Andy

There is a great need for a sarcasm font.

 

[mintjulep]

Uses Cells()

See

https://www.mrexcel.com/forum/excel-questions/48711-range-r1c1-format-vba.html

 

[DjangMan]

You can pass a string variable to Range().

dim rc as long
rc = GetLastWorksheetRow '<- you and find implementations of this on the web

dim theRange as string

dim theRow as long
for theRow = 2 to rc
[indent]theRange = "A" & cstr(theRow) & ":" & "B" & cstr(theRow)[/indent]
[indent]range(theRange).Merge[/indent]
next theRow

You can get more complicated/generic with a variable to loop through each pair of columns dynamically.

 

[Andrzejek]

Thanks mintjulep,

I've used the link you provided and ended with the code like this:

[green]'12 Months 2 Columns each
'plus 2 Columns for Total[/green]
intM = 7
For intC = 3 To 2 + (12 * 2)
    If intC Mod 2 <> 0 Then
        Cells(33, intC) = PvA_GetLettings(recL, intM) [blue]
        Range(Cells(33, intC).Address, Cells(33, intC + 1).Address).Merge[/blue]
        
        intM = intM + 1
        If intM > 12 Then intM = 1
    End If
Next intC

So the actual code is more complicated that stated originally because I deal with Fiscal Year and the data starts not in the first column, but it works like a dream

Have fun.

---- Andy

There is a great need for a sarcasm font.

 

[combo]

You could slightly simplify the code:

intM = 7
With ActiveSheet ' if applies to
    For intC = 3 To 2 + (12 * 2) Step 2
        .Cells(33, intC) = PvA_GetLettings(recL, intM) 
        Range(.Cells(33, intC)).Resize(1, 2).Merge
        
        intM = intM + 1
        If intM > 12 Then intM = 1
    Next intC
End With

combo

 

[Andrzejek]

combo,
I tried your line and got Run-time error '1004':
Method 'Range' of object '_Application' failed.

So for now I will stick with mintjulep's solution

Have fun.

---- Andy

There is a great need for a sarcasm font.

 

[combo]

Sorry, should be without "Range":
[tt].Cells(33, intC).Resize(1, 2).Merge[/tt]

combo

 

[SkipVought]

Here's a generalized solution

'
    Dim iCol As Integer, lRowStart As Long, iColStart As Integer
    Dim iMrgRws As Integer, iMrgCls As Integer, iColCnt As Integer
    
    lRowStart = 2   'start row
    iColStart = 1   'start column
    iMrgRws = 1     '# rows to merge
    iMrgCls = 2     '# columns to merge
    iColCnt = 12    'column count
    
    With ActiveSheet
        For iCol = iColStart To iColCnt * iMrgCls Step iMrgCls
            .Range(.Cells(lRowStart, iCol), .Cells(lRowStart + (iMrgRws - 1), iCol + (iMrgCls - 1))).Merge
        Next
    End With

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[SkipVought]

here's with a year/month date

'
    Dim iCol As Integer, lRowStart As Long, iColStart As Integer
    Dim iMrgRws As Integer, iMrgCls As Integer, iColCnt As Integer
    Dim dStart As Date, iMoCnt As Integer
    
    lRowStart = 2   'start row
    iColStart = 1   'start column
    iMrgRws = 1     '# rows to merge
    iMrgCls = 2     '# columns to merge
    iColCnt = 12    'column count
    dStart = #3/1/2018#
    
    With ActiveSheet
        For iCol = iColStart To iColCnt * iMrgCls Step iMrgCls
            With .Range(.Cells(lRowStart, iCol), .Cells(lRowStart + (iMrgRws - 1), iCol + (iMrgCls - 1)))
                .Merge
                .NumberFormat = "yyyy mmm"
                .Value = DateSerial(Year(dStart), Month(dStart) + iMoCnt, 1)
                iMoCnt = iMoCnt + 1
            End With
        Next
    End With

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]