Anybody good with VBA?

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
try this, I have assumed the games are in column A and b of sheet1 and the ranking data and dates in sheets 2 columns a to d, results in column C of sheet 1.
Fairly easy with VBA
Code:
Sub test3()
With Worksheets("Sheet2")
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
rankarr = Range(.Cells(1, 1), .Cells(lastrow, 4))
End With
With Worksheets("Sheet1")
lastrow1 = .Cells(Rows.Count, "A").End(xlUp).Row
games = Range(.Cells(1, 1), .Cells(lastrow1, 2))
Range(.Cells(1, 3), .Cells(lastrow1, 3)) = ""
outarr = Range(.Cells(1, 3), .Cells(lastrow1, 3))
outarr(1, 1) = "Ranking2"


For i = 2 To lastrow1
 For j = 2 To lastrow
  If games(i, 1) = rankarr(j, 1) Then
   ' check dates
    If games(i, 2) >= rankarr(j, 3) And games(i, 2) <= rankarr(j, 4) Then
     outarr(i, 1) = rankarr(j, 2)
     Exit For
    End If
  End If
 Next j
Next i
Range(.Cells(1, 3), .Cells(lastrow1, 3)) = outarr


End With


End Sub
 
Upvote 0
try this, I have assumed the games are in column A and b of sheet1 and the ranking data and dates in sheets 2 columns a to d, results in column C of sheet 1.
Fairly easy with VBA
Code:
Sub test3()
With Worksheets("Sheet2")
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
rankarr = Range(.Cells(1, 1), .Cells(lastrow, 4))
End With
With Worksheets("Sheet1")
lastrow1 = .Cells(Rows.Count, "A").End(xlUp).Row
games = Range(.Cells(1, 1), .Cells(lastrow1, 2))
Range(.Cells(1, 3), .Cells(lastrow1, 3)) = ""
outarr = Range(.Cells(1, 3), .Cells(lastrow1, 3))
outarr(1, 1) = "Ranking2"


For i = 2 To lastrow1
 For j = 2 To lastrow
  If games(i, 1) = rankarr(j, 1) Then
   ' check dates
    If games(i, 2) >= rankarr(j, 3) And games(i, 2) <= rankarr(j, 4) Then
     outarr(i, 1) = rankarr(j, 2)
     Exit For
    End If
  End If
 Next j
Next i
Range(.Cells(1, 3), .Cells(lastrow1, 3)) = outarr


End With


End Sub


Hi,

Thanks for helping. All of the data are on one sheet. See post #17 for the actual table.

Is it still easy if there are 300,000 rows?
 
Last edited:
Upvote 0
Here you are I have modifed the code so that it works on one sheet which I have assumed is called sheet1, change the name if that is not correct.
This should work fine with 300000 rows , in fact it is probably the only way to do it.
Code:
Sub test3()
With Worksheets("Sheet1")
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
rankarr = Range(.Cells(1, 1), .Cells(lastrow, 4))
lastrow1 = .Cells(Rows.Count, "K").End(xlUp).Row
games = Range(.Cells(1, 11), .Cells(lastrow1, 12))
Range(.Cells(1, 13), .Cells(lastrow1, 13)) = ""
outarr = Range(.Cells(1, 13), .Cells(lastrow1, 13))
outarr(1, 1) = "Ranking2"


For i = 2 To lastrow1
 For j = 2 To lastrow
  If games(i, 1) = rankarr(j, 1) Then
   ' check dates
    If games(i, 2) >= rankarr(j, 3) And games(i, 2) <= rankarr(j, 4) Then
     outarr(i, 1) = rankarr(j, 2)
     Exit For
    End If
  End If
 Next j
Next i
Range(.Cells(1, 13), .Cells(lastrow1, 13)) = outarr


End With


End Sub
 
Upvote 0
Thanks so much! Unfortunately when I run the module Excel just locks up and says not responding for 20 minutes.
 
Upvote 0
Unfortunately I don't have time to look at this today. From a one minute reading - and I haven't tried to downloaded a file - I'm thinking an UPDATE query will do this (which could be without VBA or formulas).

If the code you're trying hasn't worked, can you try it on a much smaller sample & identify if the problem is the code or the sheer size of the data?
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,286
Members
452,631
Latest member
a_potato

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top