VBA for ranking players across multiple sheets

[phimutau]

I'm looking to rank all the players on each team from each position based on the OVR in column H. I would like to have their respective ranks in Column G. So, all the QB's would be ranked against all the other sheets QB's and so on for each position. I have 228 sheets that represent 228 teams. There are A LOT of players. The above screen grab is an example of a sheet. The positions are QB, RB, WR, TE, OL, DL, LB, DB, K, and P located in Column K. Is this doable?

 

[Sektor]

You could use RANK.EQ function. For the first five players it will be:

=RANK.EQ(H2,$H$2:$H$6;1)

 

[phimutau]

There are 228 teams that I would like to rank the players against. I would like a macro to pull all the QB's OVR and then give them a rank in column G. There are probably 500+ QBs. Then I want to repeat this process for each position across all 228 sheets.

 

[maabadi]

Try This on Test File First:

Sub Test()
  Dim Lr As Long, i As Long, Sh As Worksheet, e As Long, f As Long, j As Long, Ar() As Variant, R As Double
  For Each Sh In Worksheets
  f = 2
  With Sh
  Lr = .Range("I" & Rows.Count).End(xlUp).Row
  ReDim Ar(Lr - 2)
  For i = 2 To Lr
  e = .Range("H" & i).End(xlDown).Row
  For j = i To e
  Ar(j - 2) = Application.WorksheetFunction.Rank(.Range("H" & j), .Range("H" & f & ":H" & e))
  Next j
  i = e + 1
  f = e + 2
  Next i
  .Range("G2").Resize(UBound(Ar) + 1) = Application.Transpose(Ar)
  End With
  Next Sh
End Sub

 

[phimutau]

Maabadi, I tried it and this is the message box and debug that returned.

 

[maabadi]

Are you have text or Non-Numeric Values at Column H ?
if Yes. Please Upload example sheet with Same format at column H with XL2BB Add-in to Test it?
Or Upload example file to Free Hosting Site e.g. GoogleDrive, OneDrive or DropBox and Insert link Here to Test code?

 

[phimutau]

Column H is numeric. The link to the file is below on GoogleDrive

Loading Google Sheets

 

[maabadi]

1. You Should Exclude sheets Doesn't have Same format at Column H example Sheet List
2. your Data started from Row 60
Then Change Code to this and Test it on example file?

Sub Test()
  Dim Lr As Long, i As Long, Sh As Worksheet, e As Long, f As Long, j As Long, Ar() As Variant, R As Double
  For Each Sh In Worksheets
if Sh.Name <> "List" Then
  f = 60
  With Sh
  Lr = .Range("I" & Rows.Count).End(xlUp).Row
  ReDim Ar(Lr - 60)
  For i = 60 To Lr
  e = .Range("H" & i).End(xlDown).Row
  For j = i To e
  Ar(j - 60) = Application.WorksheetFunction.Rank(.Range("H" & j), .Range("H" & f & ":H" & e))
  Next j
  i = e + 1
  f = e + 2
  Next i
  .Range("G60").Resize(UBound(Ar) + 1) = Application.Transpose(Ar)
  End With
End if
  Next Sh
End Sub

 

[phimutau]

I moved the "List" sheet out of workbook and made sure that column H was numeric for all 228 sheets. I ran the new code and got this.

 

[maabadi]

I moved the "List" sheet out of workbook

You don't need to do that, I exclude it from Sheets List at Code
Try this:

Sub Test()
  Dim Lr As Long, i As Long, Sh As Worksheet, e As Long, f As Long, j As Long, Ar() As Variant, R As Double
  On Error Goto Resum1
For Each Sh In Worksheets
if Sh.Name <> "List" Then
  f = 60
  With Sh
  Lr = .Range("H" & Rows.Count).End(xlUp).Row
  ReDim Ar(Lr - 60)
  For i = 60 To Lr
  e = Application.Match("Name", .Range("I" & f & ":I" & Lr), 0)
  Resum2:
  e = e + f - 3
  For j = i To e
  Ar(j - 60) = Application.WorksheetFunction.Rank(.Range("H" & j), .Range("H" & f & ":H" & e))
  Next j
  i = e + 2
  f = e + 3
  Next i
  .Range("G60").Resize(UBound(Ar) + 1) = Application.Transpose(Ar)
  End With
End if
  Next Sh
Resum1:
e = 1
Err.Clear
Resume Resum2
End Sub