hi how would i make this macro run though all of the sheets in my workbook i have 150 sheets named sheet1 to sheet150.
the macro looks very long but it just repeats itself looking at each row,
also is there any way of speeding this macro up
thanks in advance !
the macro looks very long but it just repeats itself looking at each row,
also is there any way of speeding this macro up
thanks in advance !
Code:
Sub Rank_1()
Range("U3").Value = "Place"
Range("V3").Value = "Name(s)"
Range("U4").Value = "1st"
Range("V4:V100").Value = ""
On Error Resume Next
For Each cell In Range("B4:R4")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B4:R4"), 0)
Next
For i = 1 To 10
For Each cell In Range("B5:R5")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B5:R5").ClearContents
Range("V5:V100").ClearContents
Range("U6").Value = "Place"
Range("V6").Value = "Name(s)"
Range("U7").Value = "1st"
Range("V7:V100").Value = ""
On Error Resume Next
For Each cell In Range("B7:R7")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B7:R7"), 0)
Next
For i = 1 To 10
For Each cell In Range("B8:R8")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B8:R8").ClearContents
Range("V8:V100").ClearContents
Range("U9").Value = "Place"
Range("V9").Value = "Name(s)"
Range("U10").Value = "1st"
Range("V10:V100").Value = ""
On Error Resume Next
For Each cell In Range("B10:R10")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B10:R10"), 0)
Next
For i = 1 To 10
For Each cell In Range("B11:R11")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B11:R11").ClearContents
Range("V11:V100").ClearContents
Range("U12").Value = "Place"
Range("V12").Value = "Name(s)"
Range("U13").Value = "1st"
Range("V13:V100").Value = ""
On Error Resume Next
For Each cell In Range("B13:R13")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B13:R13"), 0)
Next
For i = 1 To 10
For Each cell In Range("B14:R14")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B14:R14").ClearContents
Range("V14:V100").ClearContents
Range("U15").Value = "Place"
Range("V15").Value = "Name(s)"
Range("U16").Value = "1st"
Range("V16:V100").Value = ""
On Error Resume Next
For Each cell In Range("B16:R16")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B16:R16"), 0)
Next
For i = 1 To 10
For Each cell In Range("B17:R17")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B17:R17").ClearContents
Range("V17:V100").ClearContents
Range("U18").Value = "Place"
Range("V18").Value = "Name(s)"
Range("U19").Value = "1st"
Range("V19:V100").Value = ""
On Error Resume Next
For Each cell In Range("B19:R19")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B19:R19"), 0)
Next
For i = 1 To 10
For Each cell In Range("B20:R20")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B20:R20").ClearContents
Range("V20:V100").ClearContents
Range("U21").Value = "Place"
Range("V21").Value = "Name(s)"
Range("U22").Value = "1st"
Range("V22:V100").Value = ""
On Error Resume Next
For Each cell In Range("B22:R22")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B22:R22"), 0)
Next
For i = 1 To 10
For Each cell In Range("B23:R23")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B23:R23").ClearContents
Range("V23:V100").ClearContents
Range("U24").Value = "Place"
Range("V24").Value = "Name(s)"
Range("U25").Value = "1st"
Range("V25:V100").Value = ""
On Error Resume Next
For Each cell In Range("B25:R25")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B25:R25"), 0)
Next
For i = 1 To 10
For Each cell In Range("B26:R26")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B26:R26").ClearContents
Range("V26:V100").ClearContents
Range("U27").Value = "Place"
Range("V27").Value = "Name(s)"
Range("U28").Value = "1st"
Range("V28:V100").Value = ""
On Error Resume Next
For Each cell In Range("B28:R28")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B28:R28"), 0)
Next
For i = 1 To 10
For Each cell In Range("B29:R29")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B29:R29").ClearContents
Range("V29:V100").ClearContents
Range("U30").Value = "Place"
Range("V30").Value = "Name(s)"
Range("U31").Value = "1st"
Range("V31:V100").Value = ""
On Error Resume Next
For Each cell In Range("B31:R31")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B31:R31"), 0)
Next
For i = 1 To 10
For Each cell In Range("B32:R32")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B32:R32").ClearContents
Range("V32:V100").ClearContents
Range("U33").Value = "Place"
Range("V33").Value = "Name(s)"
Range("U34").Value = "1st"
Range("V34:V100").Value = ""
On Error Resume Next
For Each cell In Range("B34:R34")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B34:R34"), 0)
Next
For i = 1 To 10
For Each cell In Range("B35:R35")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B35:R35").ClearContents
Range("V35:V100").ClearContents
Range("U36").Value = "Place"
Range("V36").Value = "Name(s)"
Range("U37").Value = "1st"
Range("V37:V100").Value = ""
On Error Resume Next
For Each cell In Range("B37:R37")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B37:R37"), 0)
Next
For i = 1 To 10
For Each cell In Range("B38:R38")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B38:R38").ClearContents
Range("V38:V100").ClearContents
Range("U39").Value = "Place"
Range("V39").Value = "Name(s)"
Range("U40").Value = "1st"
Range("V40:V100").Value = ""
On Error Resume Next
For Each cell In Range("B40:R40")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B40:R40"), 0)
Next
For i = 1 To 10
For Each cell In Range("B41:R41")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B41:R41").ClearContents
Range("V41:V100").ClearContents
Range("U42").Value = "Place"
Range("V42").Value = "Name(s)"
Range("U43").Value = "1st"
Range("V43:V100").Value = ""
On Error Resume Next
For Each cell In Range("B43:R43")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B43:R43"), 0)
Next
For i = 1 To 10
For Each cell In Range("B44:R44")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B44:R44").ClearContents
Range("V44:V100").ClearContents
Range("U45").Value = "Place"
Range("V45").Value = "Name(s)"
Range("U46").Value = "1st"
Range("V46:V100").Value = ""
On Error Resume Next
For Each cell In Range("B46:R46")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B46:R46"), 0)
Next
For i = 1 To 10
For Each cell In Range("B47:R47")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B47:R47").ClearContents
Range("V47:V100").ClearContents
Range("U48").Value = "Place"
Range("V48").Value = "Name(s)"
Range("U49").Value = "1st"
Range("V49:V100").Value = ""
On Error Resume Next
For Each cell In Range("B49:R49")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B49:R49"), 0)
Next
For i = 1 To 10
For Each cell In Range("B50:R50")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B50:R50").ClearContents
Range("V50:V100").ClearContents
Range("U51").Value = "Place"
Range("V51").Value = "Name(s)"
Range("U52").Value = "1st"
Range("V52:V100").Value = ""
On Error Resume Next
For Each cell In Range("B52:R52")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B52:R52"), 0)
Next
For i = 1 To 10
For Each cell In Range("B53:R53")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B53:R53").ClearContents
Range("V53:V100").ClearContents
Range("U54").Value = "Place"
Range("V54").Value = "Name(s)"
Range("U55").Value = "1st"
Range("V55:V100").Value = ""
On Error Resume Next
For Each cell In Range("B55:R55")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B55:R55"), 0)
Next
For i = 1 To 10
For Each cell In Range("B56:R56")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B56:R56").ClearContents
Range("V56:V100").ClearContents
Range("U57").Value = "Place"
Range("V57").Value = "Name(s)"
Range("U58").Value = "1st"
Range("V58:V100").Value = ""
On Error Resume Next
For Each cell In Range("B58:R58")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B58:R58"), 0)
Next
For i = 1 To 10
For Each cell In Range("B59:R59")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B59:R59").ClearContents
Range("V59:V100").ClearContents
Range("U60").Value = "Place"
Range("V60").Value = "Name(s)"
Range("U61").Value = "1st"
Range("V61:V100").Value = ""
On Error Resume Next
For Each cell In Range("B58:R58")
cell.Offset(1, 0).Value = Application.Rank(cell.Value, Range("B61:R61"), 0)
Next
For i = 1 To 10
For Each cell In Range("B62:R62")
If cell.Value = i Then
setPlace = setPlace & cell.Offset(-2, 0).Value & ", "
End If
Next cell
Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = Left(setPlace, Len(setPlace) - 2)
setPlace = ""
Next i
Range("B62:R62").ClearContents
Range("V62:V100").ClearContents
End Sub