Obtain 100 percent result .

[Sunline]

Hello all ,

I am wanting to get a macro to do the following due to having 440,000 rows to go thru .

Cols BL and BP are the results I require where results will always be 100 .

Col BL results come from looking in col BT and If Good then finding all horses in col BJ that
came <=5 . Result shows 15 x .

Col BP results come from looking in col BT for Good , then finding all horses in col BJ that came >=6 ,
then looking in col BK for all that came <=5.5 lenghts away . Result shows only 2 x .

Many thanks .

Excel Workbook
	BJ	BK	BL	BP	BT
1	Plc	Mg	GdPl	GdMg	Good
2	12	12.7			Good
3	11	12.3			Good
4	3	5	100		Good
5	7	9.9			Good
6	2	3	100		Good
7	4	5.1	100		Good
8	8	10			Good
9	10	11.8			Good
10	F	F			Good
11	1	3	100		Good
12	5	8.6	100		Good
13	6	9.1			Good
14	9	10.5			Good
15	5	6.2	100		Good
16	7	9			Good
17	1	3	100		Good
18	6	8			Good
19	2	3	100		Good
20	3	5.8	100		Good
21	4	6.1	100		Good
22	LR	LR			Good
23	1	0.1	100		Good
24	9	10.3			Good
25	3	2.4	100		Good
26	7	5.1		100	Good
27	4	3.4	100		Good
28	8	8.8			Good
29	5	4.4	100		Good
30	2	0.1	100		Good
31	6	4.5		100	Good
Sheet1

 

[JoeMo]

Excel Workbook
	BJ	BK	BL	BM	BN
1	Plc	Mg	GdPl	GdMg	Good
2	12	13			Good
3	11	12			Good
4	3	5	100		Good
5	7	9.9			Good
6	2	3	100		Good
7	4	5.1	100		Good
8	8	10			Good
9	10	12			Good
10	F	F			Good
11	1	3	100		Good
12	5	8.6	100		Good
13	6	9.1			Good
14	9	11			Good
15	5	6.2	100		Good
16	7	9			Good
17	1	3	100		Good
18	6	8			Good
19	2	3	100		Good
20	3	5.8	100		Good
21	4	6.1	100		Good
22	LR	LR			Good
23	1	0.1	100		Good
24	9	10			Good
25	3	2.4	100		Good
26	7	5.1		100	Good
27	4	3.4	100		Good
28	8	8.8			Good
29	5	4.4	100		Good
30	2	0.1	100		Good
31	6	4.5		100	Good
Sheet1

 

[Peter_SSs]

I am wanting to get a macro to do the following due to having 440,000 rows to go thru .

See if this does what you want.

Sub Good()
  Dim aData As Variant, aBL As Variant, aBP As Variant, aRws As Variant, aCols As Variant
  Dim lr As Long, i As Long
  
  lr = Range("BT" & Rows.Count).End(xlUp).Row
  aRws = Evaluate("row(2:" & lr & ")")
  aCols = Array(62, 63, 72)                     '<- Columns BJ, BK, BT
  aData = Application.Index(Cells, aRws, aCols)
  ReDim aBL(1 To UBound(aData), 1 To 1)
  ReDim aBP(1 To UBound(aData), 1 To 1)
  For i = 1 To UBound(aData)
    If aData(i, 3) = "Good" Then
      If aData(i, 1) <= 5 Then
        aBL(i, 1) = 100
      ElseIf aData(i, 2) <= 5.5 Then
        aBP(i, 1) = 100
      End If
    End If
  Next i
  Range("BL2:BL" & lr).Value = aBL
  Range("BP2:BP" & lr).Value  = aBP
End Sub

 

[Sunline]

Thanks guys , i will try these out .