Loop through multiple columns with variable ranges

[dimitris798]

I'm trying to create a vba code that will calculate the monthly averages and percent of totals for variable number of years. I was able to do these calculations for specific ranges (e.g. pre-disability and disability periods) but I have difficulty using the same vba code for a post-disability period because the number of years may vary from case to case. I was hoping I can do it with a loop function but I'm not sure if it will work. Provide below is a screenshot of the excel file and sample of the vba code:


https://lh3.googleusercontent.com/t...C915AJi-t7A4tWRQI-JDWBZ38_TZw28ESIhqcPbQ=s170

'add monthly averages'

Range("8:8").Select
    Selection.Find(What:="a-pre", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(1, 1).Select


Dim Rindex As Long 'row numbers can be > 32767
Dim Cindex As Integer
Dim myCal As String
Dim Cref As Integer


Rindex = 1
Cindex = 5
myCal = ActiveCell.Column
Cref = myCal - 1 - Cindex


strArg = Cells(Rindex, Cindex).Resize(1, Cref).Address(0, -1, xlR1C1)




strArg = "=AVERAGE(" & strArg & ")"
ActiveCell.FormulaR1C1 = strArg
Selection.NumberFormat = "_(* #,#[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=0_"]#0_[/URL] );_(* (#,##0);_(* ""-""_);_(@_)"


Dim LastRows As Long
Dim myCol As String


myCol = Left(ActiveCell.Address(1, 0), InStr(1, Cells(1, 45).Address(1, 0), "$") - 1)


LastRows = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range(myCol & "9:" & myCol & LastRows).FillDown
Range(myCol & "8:" & myCol & LastRows).Interior.Color = RGB(228, 223, 236)
Range(myCol & "8:" & myCol & LastRows).Font.Bold = True






Range("8:8").Select
    Selection.Find(What:="b-dis", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(1, 1).Select


Dim Rindexq As Long 'row numbers can be > 32767
Dim Cindexq As Integer
Dim myCalq As String
Dim Crefq As Integer


Rindexq = 1
Cindexq = myCal + 2
myCalq = ActiveCell.Column
Crefq = myCalq - Cindexeq


strArg = Cells(Rindexq, Cindexq).Resize(1, 1).Address(0, -1, xlR1C1)




strArg = "=AVERAGE(" & strArg & ")"
ActiveCell.FormulaR1C1 = strArg
Selection.NumberFormat = "_(* #,#[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=0_"]#0_[/URL] );_(* (#,##0);_(* ""-""_);_(@_)"


Dim LastRowsqq As Long
Dim myColqq As String


myColqq = Left(ActiveCell.Address(1, 0), InStr(1, Cells(1, 45).Address(1, 0), "$") - 1)


LastRowsqq = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range(myColqq & "9:" & myColqq & LastRowsqq).FillDown
Range(myColqq & "8:" & myColqq & LastRowsqq).Interior.Color = RGB(228, 223, 236)
Range(myColqq & "8:" & myColqq & LastRowsqq).Font.Bold = True


'THIS IS THE PART WHERE I WOULD LIKE TO ADD MONTHLY AVERAGE FOR EACH POST-DISABILITY YEAR'
















'add % columns'


Range("9:9").Select
    Selection.Find(What:="a-pre", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 2).Select
Dim MyRange As Range


Set MyRange = Range(ActiveCell, ActiveCell)


MyRange.Select


Dim LastRowsb As Long
Dim myColb As String


myColb = Left(ActiveCell.Address(1, 0), InStr(1, Cells(1, 45).Address(1, 0), "$") - 1)


LastRowsb = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row


MyRange.FormulaR1C1 = "=RC[-1]/R" & LastRowsb & "C[-1]"




ActiveCell.NumberFormat = "0.00%"


Range(myColb & "10:" & myColb & LastRowsb).FillDown
Range(myColb & "9:" & myColb & LastRowsb).Interior.Color = RGB(253, 233, 217)
Range(myColb & "9:" & myColb & LastRowsb).Font.Bold = True


Range("9:9").Select
    Selection.Find(What:="b-dis", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 2).Select
Dim MyRangee As Range


Set MyRangee = Range(ActiveCell, ActiveCell)


MyRangee.Select


Dim LastRowsbe As Long
Dim myColbe As String


myColbe = Left(ActiveCell.Address(1, 0), InStr(1, Cells(1, 45).Address(1, 0), "$") - 1)


LastRowsbe = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row


MyRangee.FormulaR1C1 = "=RC[-1]/R" & LastRowsb & "C[-1]"




ActiveCell.NumberFormat = "0.00%"


Range(myColbe & "10:" & myColbe & LastRowsbe).FillDown
Range(myColbe & "9:" & myColbe & LastRowsbe).Interior.Color = RGB(253, 233, 217)
Range(myColbe & "9:" & myColbe & LastRowsbe).Font.Bold = True


'THIS IS THE PART WHERE I WOULD LIKE TO ADD % OF TOTALS FOR EACH POST-DISABILITY YEAR'