Automated selection of range based on cell values

[Genghis Conn]

Hey guys, I'm a high school student working on a passion project of mine and need some help. It's my first time posting on this forum so I'm sorry if I'm omitting any information.

I'm dealing with a few large excel sheets of around 250,000 rows and 15 columns. In Row 3 Column R I have the following formula =(SUM(M3:M514)/SUM(K3:K514))*75. This formula updates and repeats each time a value in column E changes, which is usually around every 600 rows but can vary by +/-500 rows. For an example of and update to this formula, the second iteration of this formula is =(SUM(M515:M1259)/SUM(K515:K1259))*75 and appears at Row 515 Column R. What I need is a solution/macro that can input the above formula each time it detects a change in the repeating values in column E and is capable of changing the end of the range to the cell immediately before the next change in Column E. The first part seems relatively easy, the second not so much haha.

Inserted above is an example of the data, so at 1260 the name in Column E changes so my range ends 1 before that at 1259.

I'm running Office 365 for Mac. Thanks for any help you can offer.

 

[davesexcel]

First part of the code will get the unique items, 2nd part will find the first and last instance of that item and place the calculation in R and 1st row.

I am not sure how long it will take for 250K rows or the difference the code has to be for xlMac.

Sub GetUniqueAndAddFormulas()
    Dim cUnique As Collection
    Dim rng As Range
    Dim Cell As Range
    Dim sh As Worksheet
    Dim vNum As Variant
    Dim StartRow As Long, EndRow As Long
    Dim Mrng As Range, Krng As Range
    Dim x As Double

    Set sh = ThisWorkbook.Sheets("Sheet1")

    With sh
        Set rng = .Range("E3:E" & .Cells(.Rows.Count, "E").End(xlUp).Row)
        Set cUnique = New Collection

        On Error Resume Next
        For Each Cell In rng.Cells
            cUnique.Add Cell.Value, CStr(Cell.Value)
        Next Cell
        On Error GoTo 0

        For Each vNum In cUnique
            StartRow = .Columns(5).Find(What:=vNum, LookAt:=xlWhole, MatchCase:=False).Row
            EndRow = .Columns(5).Find(What:=vNum, LookAt:=xlWhole, SearchDirection:=xlPrevious, MatchCase:=False).Row

            Set Mrng = .Range("M" & StartRow & ":M" & EndRow)
            Set Krng = .Range("K" & StartRow & ":K" & EndRow)

            With Application
                With .WorksheetFunction
                    x = .Sum(Mrng) / .Sum(Krng)
                End With

            End With

            .Range("R" & StartRow) = x * 0.75

        Next vNum
    End With
End Sub

 

[GlennUK]

Hi Genghis Conn, can I ask what the following stage is? That is, what do you do with column R once you have all the results? It seems to me that you are wanting this formula for some kind of summary, and that can be done very simply with a PivotTable.

 

[Genghis Conn]

Hi Genghis Conn, can I ask what the following stage is? That is, what do you do with column R once you have all the results? It seems to me that you are wanting this formula for some kind of summary, and that can be done very simply with a PivotTable.

Hi Glenn, this isn't the final stage in my evaluation. Once I fill column R I will be further comparing its values to other columns in the worksheet.

 

[Genghis Conn]

First part of the code will get the unique items, 2nd part will find the first and last instance of that item and place the calculation in R and 1st row.

I am not sure how long it will take for 250K rows or the difference the code has to be for xlMac.

Sub GetUniqueAndAddFormulas()
    Dim cUnique As Collection
    Dim rng As Range
    Dim Cell As Range
    Dim sh As Worksheet
    Dim vNum As Variant
    Dim StartRow As Long, EndRow As Long
    Dim Mrng As Range, Krng As Range
    Dim x As Double

    Set sh = ThisWorkbook.Sheets("Sheet1")

    With sh
        Set rng = .Range("E3:E" & .Cells(.Rows.Count, "E").End(xlUp).Row)
        Set cUnique = New Collection

        On Error Resume Next
        For Each Cell In rng.Cells
            cUnique.Add Cell.Value, CStr(Cell.Value)
        Next Cell
        On Error GoTo 0

        For Each vNum In cUnique
            StartRow = .Columns(5).Find(What:=vNum, LookAt:=xlWhole, MatchCase:=False).Row
            EndRow = .Columns(5).Find(What:=vNum, LookAt:=xlWhole, SearchDirection:=xlPrevious, MatchCase:=False).Row

            Set Mrng = .Range("M" & StartRow & ":M" & EndRow)
            Set Krng = .Range("K" & StartRow & ":K" & EndRow)

            With Application
                With .WorksheetFunction
                    x = .Sum(Mrng) / .Sum(Krng)
                End With

            End With

            .Range("R" & StartRow) = x * 0.75

        Next vNum
    End With
End Sub

Thank you so much, this is working great. Only took about 10 minutes to run too!