Thread: Ranking with vba or ?

Hi

I've put this into column I for the moment so you can see the output separately. See how it goes.

Sub aaa()
  holder = ""
  For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
    If Not (Cells(i, 2).Interior.ColorIndex = xlNone) Then
      holder = holder & Cells(i, 2).Address(ReferenceStyle:=xlR1C1) & ","
      Cells(i, "I").FormulaR1C1 = "=rank(rc2,salary)"
    End If
  Next i
  
  ActiveWorkbook.Names.Add Name:="salary", RefersTo:="=" & Left(holder, Len(holder) - 1)
End Sub

rylo

Thanks Rylo - - Sorry for my late response. I tried this on the test file and it seemed to work great. Once I copied it into the actual data file the cell value was #name?. There is a bit of a change in the layout but I thought I had it all tweaked. The actual Rank Column would be A, the column I wish to rank is found in column K. Sorry for this, I thought I'd be able to reference the columns and be OK, but I guess not! Any thoughts/suggestions on how to further tweak your vba code?

Thanks again, and I do appologize for my late response to your very good work!

Hi

Put up a new example file with the revised structure.

rylo

Hi Rylo - - I took the real file and changed the names of the companies and the Dollar values. The Rank Column is Column A. The column I wish to rank is Column K, only those in shaded.

Also, as a side note ( I think I might be able to firgure this one out, but) you might notice also in Column K that is shaded is the subtotal and total values. Those I would not want to rank. From report to report (I'll be doing about 30 of these) and each one has different row numbers, so I was looking to add come code that would look down Column G for the words Sub Totals or Totals and if found to offset the 5th cell over and change it's background shade to none, then run though the ranking code, thus not ranking the subtotal and total value.

I've attached the file, hope this helps and thanks again for your attention to this!

Hi

How about

Sub bbb()
  Dim holder As Range
  Dim first As Boolean
  first = True
  For i = 15 To Cells(Rows.Count, 9).End(xlUp).Row
    If Not (Cells(i, 9).Interior.ColorIndex = xlNone) And Left(Cells(i, 7), 3) <> "Sub" And Left(Cells(i, 7), 3) <> "TOT" Then
      If first Then
        Set holder = Cells(i, 9)
        first = False
      Else
        Set holder = Union(holder, Cells(i, 9))
      End If
    End If
  Next i
  
  For i = 15 To Cells(Rows.Count, 9).End(xlUp).Row
    If Not (Cells(i, 9).Interior.ColorIndex = xlNone) And Left(Cells(i, 7), 3) <> "Sub" And Left(Cells(i, 7), 3) <> "TOT" Then
      Cells(i, "A").FormulaR1C1 = WorksheetFunction.Rank(Cells(i, 9).Value, holder)
    End If
  Next i
  
End Sub

rylo

Rylo - - Right on! Thanks...I've tested this by changing the order...ect and rerunning. Works GREAT! I also was able to get the other loop process in place to unshade those cells that are offset from the Subtotal, total rows. Then this code runs, thus not 'ranking' those that were changed to xlnone..between the two pieces of code it works great!

I thought I'd post the two pieces of code and save this on as Solved...here's the first part that unshades the sub total and total cells (offset) from column G to K:

With Worksheets("Cur").Range("g:g")
Set c = Cells.Find(What:="TOTALS", after:=[a1], LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlAll, MatchCase:=False)
    If Not c Is Nothing Then
        firstaddress = c.Address
        Do
            c.Offset(0, 4).Interior.ColorIndex = xlNone
                Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstaddress
            End If
        End With

And here's the code you just sent me, again works really really well:

Dim holder As Range
  Dim first As Boolean
  first = True
  For i = 15 To Cells(Rows.Count, 11).End(xlUp).Row
    If Not (Cells(i, 11).Interior.ColorIndex = xlNone) And Left(Cells(i, 7), 3) <> "Sub" And Left(Cells(i, 7), 3) <> "TOT" Then
      If first Then
        Set holder = Cells(i, 11)
        first = False
      Else
        Set holder = Union(holder, Cells(i, 11))
      End If
    End If
  Next i
  
  For i = 15 To Cells(Rows.Count, 11).End(xlUp).Row
    If Not (Cells(i, 11).Interior.ColorIndex = xlNone) And Left(Cells(i, 7), 3) <> "Sub" And Left(Cells(i, 7), 3) <> "TOT" Then
      Cells(i, "A").FormulaR1C1 = WorksheetFunction.Rank(Cells(i, 11).Value, holder)
    End If
  Next i

Have a good day and enjoy the weekend!