Merge every 9 Cells Loop

[TenDollarTypo]

How could I modify this code to make it merge every 9 cells in one column or two/three columns if I like:
Dim iRow As Integer, lRowStart As Long, iColStart As Integer
Dim iMrgRws As Integer, iMrgCls As Integer, iColCnt As Integer
Dim iRwsCnt As Long

lRowStart = 2 'start row
iColStart = 1 'start column
iMrgRws = 9 '# rows to merge
iMrgCls = 2 '# columns to merge
iColCnt = 1 'column count
iRwsCnt = 1 'row count

With ActiveSheet
For iRow = lRowStart To iRwsCnt * iMrgRws Step iMrgRws
.Range(.Cells(lRowStart, iRow), .Cells(lRowStart + (iMrgRws - 1), iRow + (iMrgRws - 1))).Merge
Next
End With
End Sub
Any suggestion would be helpful?

 

[SkipVought]

Hi,

Welcome to Tek-Tips.

I'd recommend using a table of values rather than hard coding data in your procedure.

Sub Somename()
    Dim r As Long, c As Integer 'merge area index
    Dim lRowStart As Long, iColStart As Integer 'start first merge area
    Dim iMrgRws As Integer, iMrgCls As Integer 'merge area size
    Dim iMrgVCnt As Long, iMrgHCnt As Integer 'merge area counts
    Dim lRow1 As Long, iCol1 As Integer, lRow2 As Long, iCol2 As Integer 'from/to rows & cols

    lRowStart = 2   'start row
    iColStart = 1   'start column
    iMrgRws = 9     '# rows to merge
    iMrgCls = 2     '# columns to merge
    iMrgVCnt = 2    'merge vertical count
    iMrgHCnt = 3    'merge horizontal count
    
    With ActiveSheet
        For r = 0 To iMrgVCnt - 1                       'vertical merge counter loop
            lRow1 = lRowStart + r * iMrgRws             'merge from row
            lRow2 = lRowStart + (r + 1) * iMrgRws - 1   'merge to row
            
            For c = 0 To iMrgHCnt - 1                       'horizontal merge counter loop
                iCol1 = iColStart + c * iMrgCls             'merge from column
                iCol2 = iColStart + (c + 1) * iMrgCls - 1   'merge to column
                
                .Range(.Cells(lRow1, iCol1), .Cells(lRow2, iCol2)).Merge    'merge range
            Next
        Next
    End With
End Sub

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

You Matter...
unless you multiply yourself by the speed of light squared, then...
You Energy!

 

[SkipVought]

Here's a workbook w/ VBA using Named Ranges for each required parameter.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

You Matter...
unless you multiply yourself by the speed of light squared, then...
You Energy!

 

[TenDollarTypo]

This is awesome! Thank you so much! Yo man this code is amazing! Exactly what I was looking for. I really hope I can get this good and be able to code this out myself someday.