VBA - Loop & Offset Code Help - PLEASE!

[nalij]

Good Afternoon,

Thanks in advance for any assistance that can be offered, now on to the dilemma.

Background: I am trying to create a dynamic repeatable formatting process. I have an ever changing list of metrics that are either populated with a value or not. Each metric with a value has a graph created based on the last 12 weeks. I have a structured view witch places all of the graphs onto a single worksheet. The formatting and placement of the graphs are what I am tying to solve for now.

Problem: The current code I have now creates a single instance of the formatting for a single metric. I want to be able to repeat this formatting based on a cell number (in my below code this would be cell A1). However, the code needs to be dynamic since the number will be ever changing.

Sub Offset()

iNumberOfLoops = Range("A1").Value


For i = 1 To iNumberOfLoops


With Range("B2").Offset(6, 0)


Call Format


End With
Next i


End Sub

FYI:

Sub Format()'
' Formatting Macro
'


'Build the header for the metric name
    Range("B2:F2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .MergeCells = True
    End With


    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
 
'Format the outline of cells for the graph  
    Range("B2:F11").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With


End Sub

Details: So the goal is to build the formatting starting in cell B2:F11 then repeat this to the right 5 times. I can get it to repeat but it just does it in place (B2) instead of offsetting to the next area (which should be G2:K11, then L2:P11, Q2:U11, V2:Z11).


Any assistance would be really appreciated here, since I am racking my brain and just cannot figure out how to make this work. Thanks.

 

[lrobbo314]

How about this?

Sub Format() '
Dim r As Range
Dim i As Integer
Set r = Range("B2:F11")
For i = 1 To 5
If i <> 1 Then
    Set r = r.Offset(, 1)
    Set r = r.Resize(10, 5)
End If
    With r
        .HorizontalAlignment = xlCenter
        .MergeCells = True
    End With

    With r.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With r.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With r.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With r.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
 
    With r.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With r.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With r.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With r.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
Next i

End Sub

 

[Andrew Poulsom]

Alternatively:

Sub Offset()
    iNumberOfLoops = Range("A1").Value
    For i = 1 To (iNumberOfLoops * 5) Step 5
'       Build the header for the metric name
        With Range("A2").Offset(0, i).Resize(1, 5)
            .HorizontalAlignment = xlCenter
            .MergeCells = True
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
'           Format the outline of cells for the graph
            With .Resize(10)
                With .Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                End With
                With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                End With
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                End With
                With .Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                End With
            End With
        End With
    Next i
End Sub

 

[Mindpsyche]

I suggest you use Andrew's but as I wrote this code, I might as well share it.
Only one macro here, let me know if this works please.

Sub Format()
Dim inumberofloops As Long
Dim i As Long
Dim j As Long
j = 2
inumberofloops = Range("A1").Value
For i = 1 To inumberofloops
    Range(Cells(2, j), Cells(2, j + 4)).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .MergeCells = True
        .borders.LineStyle = xlContinuous
        .borders.Weight = xlMedium
    End With
    With Range(Cells(2, j), Cells(11, j + 4)).borders
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    j = j + 5
Next i
End Sub

 

[nalij]

Thanks everyone for the extremely quick responses. I did indeed end up using Andrew's code.

I really do appreciate the assistance!!!

 

[nalij]

Sorry - one follow up that I thought I would be able to solve but apparently not so easy for me.

Now that I have the cells repeat across horizontally. What would be the appropriate code to copy this and paste it vertically based on a loop driven by the value of cell B1?

Here is the code I wrote to try and attempt this feat:

Sub Vert()

    inumberofloops = Range("B1").Value
    For i = 1 To inumberofloops
    
    Rows("2:11").Select
    Selection.Copy
    Range("A11").Offset(10, 0).Paste
    
    Next i
    
End Sub

Summary: So I would be copy the formatted cells in row2:11 and pasting them X times (based on cell B1 value) vertically. So row2:11 would be formatted along with 12:21, 22:31, 32:41, etc.



Again, I really do appreciate the assistance that this members of this forum offer.

 

[Andrew Poulsom]

Try:

Sub Vert()
    inumberofloops = Range("B1").Value
    For i = 1 To inumberofloops
        Rows("2:11").Copy Range("A2").Offset(10 * i, 0)
    Next i
End Sub

 

[nalij]

Thank you Andrew.

I was so close but you hit it home! I really appreciate your assistance, thanks for your time!