MACRO that organises, groups, outlines (Need to adjust the area that the macro applies to)

Question

How to apply this from A4 instead of A2. Everything else I am happy with. I just want to understand any changes that I need to make to this.

Is it needing changes at "set population"? The 2?

Sub formatresults()

Dim lastRow As Long
Dim pop As Range
Dim rpSet As Range
Dim rpSetNames As Range
Dim sBeg As Integer
Dim sEnd As Integer
Dim rpName As String
Dim x As Integer
Dim y As Integer


lastRow = Range(Cells(99999, 1), Cells(99999, 1)).End(xlUp).row
Set pop = Range(Cells(2, 1), Cells(lastRow, 7))
sBeg = 2
sEnd = 2
y = 1
rpName = Cells(2, 1)
Range(Cells(1, 7), Cells(lastRow, 7)).NumberFormat = "0.00%"

For x = 2 To lastRow

    If Cells(sEnd + 1, 1) = rpName Then
        sEnd = sEnd + 1
    Else
        Set rpSet = Range(Cells(sBeg, 1), Cells(sEnd, 7))
        Set rpSetNames = Range(Cells(sBeg, 1), Cells(sEnd, 1))
        rpSet.BorderAround Weight:=xlMedium

        If y Mod 2 = 1 Then rpSetNames.Interior.ColorIndex = 15

        sBeg = sEnd + 1
        sEnd = sEnd + 1
        rpName = Cells(sBeg, 1)
        y = y + 1
    End If

Next x

End Sub

Many thanks!

score 0 · Accepted Answer · edited May 23 '17 at 12:22

I added a new variable StartFrom so that you'll only have to change the value once to make it work on a different range.

Also, I changed the definition of lastRow, take a look at Error in finding last used cell in VBA

Give this a try :

Sub formatresults()

Dim lastRow As Long
Dim pop As Range
Dim rpSet As Range
Dim rpSetNames As Range
Dim sBeg As Integer
Dim sEnd As Integer
Dim rpName As String
Dim x As Integer
Dim y As Integer, _
    StartFrom As Integer

StartFrom = 4

lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set pop = Range(Cells(StartFrom, 1), Cells(lastRow, 7))
sBeg = StartFrom
sEnd = StartFrom
y = 1
rpName = Cells(StartFrom, 1) '----
Range(Cells(1, 7), Cells(lastRow, 7)).NumberFormat = "0.00%"

For x = StartFrom To lastRow '----

    If Cells(sEnd + 1, 1) = rpName Then
        sEnd = sEnd + 1
    Else
        Set rpSet = Range(Cells(sBeg, 1), Cells(sEnd, 7))
        Set rpSetNames = Range(Cells(sBeg, 1), Cells(sEnd, 1))
        rpSet.BorderAround Weight:=xlMedium

        If y Mod 2 = 1 Then rpSetNames.Interior.ColorIndex = 15

        sBeg = sEnd + 1
        sEnd = sEnd + 1
        rpName = Cells(sBeg, 1)
        y = y + 1
    End If

Next x

End Sub

MACRO that organises, groups, outlines (Need to adjust the area that the macro applies to)

1 Answers1