Anybody good with VBA?

[kmprice710]

I went through some Index and Sumproduct solutions with AhoyNC in this thread:

https://www.mrexcel.com/forum/excel...st-date-range-return-value-2.html#post5095694

But ultimately my data table is too big (last post in thread has a URL) and complicated for anything less than a VBA solution.

Can anybody with a VBA make some suggestions?

Much obliged.

 

[offthelip]

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

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

 

[kmprice710]

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

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?

 

[offthelip]

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.

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

 

[kmprice710]

Thanks so much! Unfortunately when I run the module Excel just locks up and says not responding for 20 minutes.

 

[Fazza]

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?