G
Gareth
I have a sheet containing details of cattle.
Column A has the eartag, columns C, D and E have the date
moved on, off and death.
Columns I and J have a date range (two months).
I want to check whether:
1. Date on falls within the date range, put result in
column K
2. Date off falls within the date range, put result in
column L
3. Date of death falls within the date range, put result
in column M
I have managed to do it using the following but is there
an easier way, possibly not involving entering formula.
Sub CheckDateRange()
Application.ScreenUpdating = False
With Worksheets("Sheet1")
Set movedon = .Range("C2:C" & Range("A" & Rows.Count).End
(xlUp).Row)
Set movedoff = .Range("D2
" & Range("A" & Rows.Count).End
(xlUp).Row)
Set died = .Range("E2:E" & Range("A" & Rows.Count).End
(xlUp).Row)
For Each cell In movedon
cell.Offset(0, 8).Value = "=IF(AND(RC[-8]>=RC[-2],RC[-8]
<=RC[-1]),""Yes"",""No"")"
Next cell
For Each cell In movedoff
cell.Offset(0, 8).Value = "=IF(AND(RC[-8]>=RC[-3],RC[-8]
<=RC[-2]),""Yes"",""No"")"
Next cell
For Each cell In died
cell.Offset(0, 8).Value = "=IF(AND(RC[-8]>=RC[-4],RC[-8]
<=RC[-3]),""Yes"",""No"")"
Next cell
..Range("K2:N" & Range("A" & Rows.Count).End(xlUp).Row).Copy
..Range("K2").Activate
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Range("A1").Activate
End With
Application.ScreenUpdating = True
End Sub
Thanks in advance.
Gareth
Column A has the eartag, columns C, D and E have the date
moved on, off and death.
Columns I and J have a date range (two months).
I want to check whether:
1. Date on falls within the date range, put result in
column K
2. Date off falls within the date range, put result in
column L
3. Date of death falls within the date range, put result
in column M
I have managed to do it using the following but is there
an easier way, possibly not involving entering formula.
Sub CheckDateRange()
Application.ScreenUpdating = False
With Worksheets("Sheet1")
Set movedon = .Range("C2:C" & Range("A" & Rows.Count).End
(xlUp).Row)
Set movedoff = .Range("D2
(xlUp).Row)
Set died = .Range("E2:E" & Range("A" & Rows.Count).End
(xlUp).Row)
For Each cell In movedon
cell.Offset(0, 8).Value = "=IF(AND(RC[-8]>=RC[-2],RC[-8]
<=RC[-1]),""Yes"",""No"")"
Next cell
For Each cell In movedoff
cell.Offset(0, 8).Value = "=IF(AND(RC[-8]>=RC[-3],RC[-8]
<=RC[-2]),""Yes"",""No"")"
Next cell
For Each cell In died
cell.Offset(0, 8).Value = "=IF(AND(RC[-8]>=RC[-4],RC[-8]
<=RC[-3]),""Yes"",""No"")"
Next cell
..Range("K2:N" & Range("A" & Rows.Count).End(xlUp).Row).Copy
..Range("K2").Activate
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Range("A1").Activate
End With
Application.ScreenUpdating = True
End Sub
Thanks in advance.
Gareth