Merging Cells in Excel from an Array - arrays

Question

Here is what I'm trying to accomplish: Cell B2: Start Date and Cell B3: End Date
Example:
B2 --> 01/01/2019
B3 --> 01/03/2019
I have an array with the week numbers between these two dates. Example array (1, 2, 3, 4, 5, 6, 7, 8, 9), including the last week of February(week 9). I'm Working on a Planning excel that's why I'm considerating also week 9 (We had some issues in the last post, that's why I'm explaining it)
Here is my code for obtaining this array
Sub FillCal()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim StartDate As Range, EndDate As Range
Dim NoOfWeeks As Long
Dim arr As Variant
Dim i As Long
With Worksheets("Foglio1")
Set StartDate = .Range("B2")
Set EndDate = .Range("B3")
End With
NoOfWeeks = WorksheetFunction.RoundUp((EndDate.Value2 - StartDate.Value2) / 7, 0)
ReDim arr(1 To NoOfWeeks)
For i = 1 To NoOfWeeks
arr(i) = i
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
What I'm trying to do is: Starting from Cell D4, put the 1st value of the array arr in it and merge cells E4 and F4 with it(so cells D4, E4, F4 merged with value 1), put next value of the array(in this case Cell G4 and value 2) in it and merge the 2 other cells on the right so it would be Cells G4, H4, I4 with value 2 and so on... till last value of the array (Sorry for bad English I will attach a photo for better understanding)
Here is the output that I would like to obtain:
So Its basically: merge every 3 cells.
Since an user asked for it, here is how I try to merge...
i = wks.Range("A3").End(xlToRight).Row
Set rngMerge = wks.Range("A3:XZ3" & i) ' Find last row in column A
With wks
checkAgain:
For Each rngCell In rngMerge
If rngCell.Value = rngCell.Offset(0, 1).Value And IsEmpty(rngCell) = False Then
Range(rngCell, rngCell.Offset(0, 1)).Merge
rngCell.VerticalAlignment = xlCenter
rngCell.HorizontalAlignment = xlCenter
rngCell.BorderAround ColorIndex:=1
GoTo checkAgain
End If
Next
End With

Answer 1

Starting for D4 as a "given", point and merging any 3 cells as far as there is something in the array, this is what I have managed to build:
This is the code:
Sub TestMe()
Worksheets(1).Cells.Delete
Dim myCellToStart As Range
Set myCellToStart = Worksheets(1).Range("D4")
Dim myArray As Variant
myArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
Dim myVar As Variant
Dim myCell As Range
Set myCell = myCellToStart
For Each myVar In myArray
Set myCell = Worksheets(1).Range(myCell, myCell.Offset(, 2))
myCell.Merge
BorderMe myCell
myCell = myVar
Set myCell = myCell.Offset(, 1)
Next myVar
End Sub
The "trick" is to define the range to be merged correctly. It is carried out with Set myCell = Worksheets(1).Range(myCell, myCell.Offset(, 2)) and with Set myCell = myCell.Offset(, 1) to mark the new start.
And this is the "Bordering" function:
Public Sub BorderMe(myRange As Range)
Dim cnt As Long
For cnt = 7 To 10 '7 to 10 are the magic numbers for xlEdgeLeft etc
With myRange.Borders(cnt)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
Next
End Sub

Answer 2

You actually don't need to use an array, since you are assigning NoOfWeeks as a variable;
Just replace this portion of your first code...
ReDim arr(1 To NoOfWeeks)
For i = 1 To NoOfWeeks
arr(i) = i
Next i
With this code...
x = 4
For i = 1 To NoOfWeeks
With Cells(3, x)
.Value = i
.Resize(, 3).Merge
.HorizontalAlignment = xlCenterAcrossSelection
End With
x = x + 3
Next i