0
votes

I am looking for some assistance in macro code. I have data in columns A-E, though the rows in these columns may change from day to day. I need a way to calculate the minimum values in columns C & E, and the maximum in column D. Then in column F, I want to assign a score based on the values in columns C-E and their relation to the minimum/maximum values.

For instance, if there were 29 rows of data and a heading, then the cell C31 would have the formula "=MIN(C2:C30)" with similar setups in columns D & E. Then cell F2 would have the formula "=0.25*(1/(C2/$C$31))+0.25*D2/$D$31+0.5*E2/$E$31".

How do I address absolute cell values when the macro code uses the R[]C[] format and the row number is not static?

1

1 Answers

0
votes

So here is the code that I scrambled together. It isn't pretty, but it works and does what it is supposed to do. Any formatting tips from the community would be greatly appreciated.

Sub WeightedScore()
'
' WeightedScore Macro
'

' This will allow me to use a dynamic range of rows when sorting the table toward the end of the macro.

Dim LastRow As Integer

' This part is just some asthetic cleanup from the report that is generated

Rows("4:4").Select
Selection.Delete Shift:=xlUp
Columns("D:F").Select
Selection.Delete Shift:=xlToLeft

' These are the weights to be applied to each factor

Range("A1").Select
ActiveCell.FormulaR1C1 = "0.25"
Range("B1").Select
ActiveCell.FormulaR1C1 = "0.25"
Range("C1").Select
Selection.FormulaR1C1 = "0.5"

' This part essentially counts the rows to be sorted in the table toward the end of the macro

LastRow = Range("E3").CurrentRegion.Cells(Range("E3").CurrentRegion.Cells.Count).Row

' This code allows for the minimum and maximum values in the data column regardless of number of rows

Range("C4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.FormulaR1C1 = "=MIN(R4C3:R[-1]C)"
Range("D4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.FormulaR1C1 = "=MAX(R4C4:R[-1]C)"
Range("E4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.FormulaR1C1 = "=MIN(R4C5:R[-1]C)"

' This part is essentially admitting defeat, copying the min/max values below a variable number
' of rows, and then pasting them into static cells at the top of the sheet.

Range("C3").Select
Selection.End(xlDown).Select
Selection.Copy
Range("C2").PasteSpecial xlPasteValues
Range("D3").Select
Selection.End(xlDown).Select
Selection.Copy
Range("D2").PasteSpecial xlPasteValues
Range("E3").Select
Selection.End(xlDown).Select
Selection.Copy
Range("E2").PasteSpecial xlPasteValues

' This part names the "Score" column and applies the absolute weights and absolute min/max values
' to the relative cell values.

Range("F3").Select
Selection.FormulaR1C1 = "Score"
Range("F4").Select
Selection.FormulaR1C1 = _
    "=1/(RC[-3]/R2C3)*R1C1+RC[-2]/R2C4*R1C2+RC[-1]/R2C5*R1C3"
Selection.NumberFormat = "#,##0.00"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(-1, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste

' This is where the data is selected and sorted based on the "Score" value above. The LastRow
' function as described earlier allows for a dynamic range of rows.

Range("A3:F" & LastRow).Select
ActiveWorkbook.Worksheets("Reports").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Reports").Sort.SortFields.Add Key:=Range("F4:F" & LastRow _
    ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Reports").Sort
    .SetRange Range("A3:F" & LastRow)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

' This last part ends the macro with the highest "Score" selected

Range("F4").Select
End Sub

I hope this helps anyone with a similar issue.