Hi all, i have the code below which i got off a site. I have changed it to
suit me but i need help with the second part.. I have put comments in the
code below.

Sub Test2()
'
Dim todaysDateLong As String
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim sh4 As Worksheet, sh5 As Worksheet, sh6 As Worksheet
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Dim rw As Long, cell As Range

ActiveWorkbook.Worksheets("PU0703LCS").Rows("1:1") .Copy
ActiveWorkbook.Worksheets.Add(Befo=ActiveSheet) .Name = "LCS_KTL AI
Diff"
ActiveSheet.Paste

Set sh1 = Worksheets("PU0703LCS")
Set sh2 = Worksheets("KTL")
rw = 2
Set rng1 = sh1.Range(sh1.Cells(2, 1), sh1.Cells(2, 1).End(xlDown))
Set rng2 = sh2.Range(sh2.Cells(2, 1), sh2.Cells(2, 1).End(xlDown))
For Each cell In rng1
If Application.CountIf(rng2, cell.Value) = 0 Then

Else
Set sh4 = Worksheets("PU0703LCS")
Set sh5 = Worksheets("KTL")
Set sh6 = Worksheets("LCS_KTL AI Diff")
Set rng3 = sh4.Range(sh4.Cells(2, 2), sh4.Cells(2, 2).End(xlDown))

'--I need to know if the cell above (2) if it is higher than cell (10) below

Set rng4 = sh2.Range(sh5.Cells(2, 10), sh5.Cells(2, 10).End(xlDown))

'-- If yes then copy and paste into sh6

If Application.CountIf(rng4, cell.Value) = 0 Then
cell.EntireRow.Copy sh6.Cells(rw, 1)
rw = rw + 1
End If

End If
Next

Range("A1").Select
Columns("A:O").EntireColumn.AutoFit
End Sub

--
Les

Sub Test2()
'
Dim todaysDateLong As String
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim sh4 As Worksheet, sh5 As Worksheet, sh6 As Worksheet
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Dim rw As Long, cell As Range
Dim i as Long

ActiveWorkbook.Worksheets("PU0703LCS").Rows("1:1") .Copy
ActiveWorkbook.Worksheets.Add(Befo=ActiveSheet) .Name = "LCS_KTL AI
Diff"
ActiveSheet.Paste

' really need to references to sheet KTL?
Set sh1 = Worksheets("PU0703LCS")
Set sh2 = Worksheets("KTL")
Set sh4 = Worksheets("PU0703LCS")
Set sh5 = Worksheets("KTL")
Set sh6 = Worksheets("LCS_KTL AI Diff")
rw = 2
i = 0
Set rng1 = sh1.Range(sh1.Cells(2, 1), sh1.Cells(2, 1).End(xlDown))
Set rng2 = sh2.Range(sh2.Cells(2, 1), sh2.Cells(2, 1).End(xlDown))
For Each cell In rng1
If Application.CountIf(rng2, cell.Value) = 0 Then

Else
Set rng3 = sh4.Range(sh4.Cells(2, 2), sh4.Cells(2, 2).End(xlDown))

'--I need to know if the cell above (2) if it is higher than cell (10) below

Set rng4 = sh2.Range(sh5.Cells(2, 10), sh5.Cells(2, 10).End(xlDown))

i = i + 1
If rng4(i) < cell.Value Then
cell.EntireRow.Copy sh6.Cells(rw, 1)
rw = rw + 1
End If

End if
Next

Range("A1").Select
Columns("A:O").EntireColumn.AutoFit
End Sub

--
Regards,
Tom Ogilvy


"Les" wrote:

Hi all, i have the code below which i got off a site. I have changed it to
suit me but i need help with the second part.. I have put comments in the
code below.

Sub Test2()
'
Dim todaysDateLong As String
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim sh4 As Worksheet, sh5 As Worksheet, sh6 As Worksheet
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Dim rw As Long, cell As Range

ActiveWorkbook.Worksheets("PU0703LCS").Rows("1:1") .Copy
ActiveWorkbook.Worksheets.Add(Befo=ActiveSheet) .Name = "LCS_KTL AI
Diff"
ActiveSheet.Paste

Set sh1 = Worksheets("PU0703LCS")
Set sh2 = Worksheets("KTL")
rw = 2
Set rng1 = sh1.Range(sh1.Cells(2, 1), sh1.Cells(2, 1).End(xlDown))
Set rng2 = sh2.Range(sh2.Cells(2, 1), sh2.Cells(2, 1).End(xlDown))
For Each cell In rng1
If Application.CountIf(rng2, cell.Value) = 0 Then

Else
Set sh4 = Worksheets("PU0703LCS")
Set sh5 = Worksheets("KTL")
Set sh6 = Worksheets("LCS_KTL AI Diff")
Set rng3 = sh4.Range(sh4.Cells(2, 2), sh4.Cells(2, 2).End(xlDown))

'--I need to know if the cell above (2) if it is higher than cell (10) below

Set rng4 = sh2.Range(sh5.Cells(2, 10), sh5.Cells(2, 10).End(xlDown))

'-- If yes then copy and paste into sh6

If Application.CountIf(rng4, cell.Value) = 0 Then
cell.EntireRow.Copy sh6.Cells(rw, 1)
rw = rw + 1
End If

End If
Next

Range("A1").Select
Columns("A:O").EntireColumn.AutoFit
End Sub

--
Les

Hello Tom, thank you for your reply. This is unfortunately not doing what i
would like it to do. I have sent a copy of the spreadsheet to your e-mail
address.

best regards,

--
Les


"Tom Ogilvy" wrote:

Sub Test2()
'
Dim todaysDateLong As String
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim sh4 As Worksheet, sh5 As Worksheet, sh6 As Worksheet
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Dim rw As Long, cell As Range
Dim i as Long

ActiveWorkbook.Worksheets("PU0703LCS").Rows("1:1") .Copy
ActiveWorkbook.Worksheets.Add(Befo=ActiveSheet) .Name = "LCS_KTL AI
Diff"
ActiveSheet.Paste

' really need to references to sheet KTL?
Set sh1 = Worksheets("PU0703LCS")
Set sh2 = Worksheets("KTL")
Set sh4 = Worksheets("PU0703LCS")
Set sh5 = Worksheets("KTL")
Set sh6 = Worksheets("LCS_KTL AI Diff")
rw = 2
i = 0
Set rng1 = sh1.Range(sh1.Cells(2, 1), sh1.Cells(2, 1).End(xlDown))
Set rng2 = sh2.Range(sh2.Cells(2, 1), sh2.Cells(2, 1).End(xlDown))
For Each cell In rng1
If Application.CountIf(rng2, cell.Value) = 0 Then

Else
Set rng3 = sh4.Range(sh4.Cells(2, 2), sh4.Cells(2, 2).End(xlDown))

'--I need to know if the cell above (2) if it is higher than cell (10) below

Set rng4 = sh2.Range(sh5.Cells(2, 10), sh5.Cells(2, 10).End(xlDown))

i = i + 1
If rng4(i) < cell.Value Then
cell.EntireRow.Copy sh6.Cells(rw, 1)
rw = rw + 1
End If

End if
Next

Range("A1").Select
Columns("A:O").EntireColumn.AutoFit
End Sub

--
Regards,
Tom Ogilvy


"Les" wrote:

Hi all, i have the code below which i got off a site. I have changed it to
suit me but i need help with the second part.. I have put comments in the
code below.

Sub Test2()
'
Dim todaysDateLong As String
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim sh4 As Worksheet, sh5 As Worksheet, sh6 As Worksheet
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Dim rw As Long, cell As Range

ActiveWorkbook.Worksheets("PU0703LCS").Rows("1:1") .Copy
ActiveWorkbook.Worksheets.Add(Befo=ActiveSheet) .Name = "LCS_KTL AI
Diff"
ActiveSheet.Paste

Set sh1 = Worksheets("PU0703LCS")
Set sh2 = Worksheets("KTL")
rw = 2
Set rng1 = sh1.Range(sh1.Cells(2, 1), sh1.Cells(2, 1).End(xlDown))
Set rng2 = sh2.Range(sh2.Cells(2, 1), sh2.Cells(2, 1).End(xlDown))
For Each cell In rng1
If Application.CountIf(rng2, cell.Value) = 0 Then

Else
Set sh4 = Worksheets("PU0703LCS")
Set sh5 = Worksheets("KTL")
Set sh6 = Worksheets("LCS_KTL AI Diff")
Set rng3 = sh4.Range(sh4.Cells(2, 2), sh4.Cells(2, 2).End(xlDown))

'--I need to know if the cell above (2) if it is higher than cell (10) below

Set rng4 = sh2.Range(sh5.Cells(2, 10), sh5.Cells(2, 10).End(xlDown))

'-- If yes then copy and paste into sh6

If Application.CountIf(rng4, cell.Value) = 0 Then
cell.EntireRow.Copy sh6.Cells(rw, 1)
rw = rw + 1
End If

End If
Next

Range("A1").Select
Columns("A:O").EntireColumn.AutoFit
End Sub

--
Les

Hi Tom, did not think you would be awake... :0), Did you get my E-Mail
??

Best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

Yes I got your email, but since you provided no additional information to
explain what you wanted, it is no clearer than it was when I answered here
and you said that didn't do what you want.

--
Regards,
Tom Ogilvy


"Les Stout" wrote:

Hi Tom, did not think you would be awake... :0), Did you get my E-Mail
??

Best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

Ok, this is my best guess:

Sub TestTom()
'
Dim todaysDateLong As String
Dim sh1 As Worksheet, sh2 As Worksheet
Dim sh6 As Worksheet
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range
Dim rw As Long, cell As Range
Dim res As Variant

ActiveWorkbook.Worksheets("PU0703LCS").Rows("1:1") .Copy
ActiveWorkbook.Worksheets.Add(Befo=ActiveSheet) .Name = "LCS_KTL AI
Diff"
ActiveSheet.Paste

Set sh1 = Worksheets("PU0703LCS")
Set sh2 = Worksheets("KTL")
Set sh6 = Worksheets("LCS_KTL AI Diff")
rw = 2
Set rng1 = sh1.Range(sh1.Cells(2, 1), sh1.Cells(2, 1).End(xlDown))
Set rng2 = sh2.Range(sh2.Cells(2, 1), sh2.Cells(2, 1).End(xlDown))
For Each cell In rng1
If Application.CountIf(rng2, cell.Value) = 0 Then

Else
res = Application.Match(cell.Value, rng2, 0)
Set rng3 = rng2(res)
If cell.Offset(0, 1) sh2.Cells(rng3.Row, "J") Then
cell.EntireRow.Copy sh6.Cells(rw, 1)
rw = rw + 1
End If
End If
Next

Range("A1").Select
Columns("A:O").EntireColumn.AutoFit
End Sub

It copies about 4 records.
--
Regards,
Tom Ogilvy


"Les Stout" wrote:

Hi Tom, did not think you would be awake... :0), Did you get my E-Mail
??

Best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

Thanks will try it Tom, i put comments in the spreadsheet and thought
would be suffient.

Best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

Hello all, thank you so much for your inputs and a very special thanks
to Tom Ogilvy, it is doing exactly what i need, thank you... Very, very
much appreciated...

Best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

Les:

You can tidy the code up a little as in and you don't need the extra sheets:

Sub Test2()
'
Dim todaysDateLong As String
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim sh4 As Worksheet, sh5 As Worksheet, sh6 As Worksheet
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Dim rw As Long, cell As Range

Set sh1 = Worksheets("PU0703LCS")
ActiveWorkbook.Worksheets("PU0703LCS").Rows("1:1") .Copy
Worksheets.Add(Befo=ActiveSheet).Name = "LCS_KTL AI Diff"
ActiveSheet.Paste

Set sh2 = Worksheets("KTL")
rw = 2
Set rng1 = sh1.Range(sh1.Cells(2, 1), sh1.Cells(2, 1).End(xlDown))
Set rng2 = sh2.Range(sh2.Cells(2, 1), sh2.Cells(2, 1).End(xlDown))
For Each cell In rng1
If Application.CountIf(rng2, cell.Value) = 0 Then

Else
' Set sh4 = Worksheets("PU0703LCS") ' this is the same as sh1
' Set sh5 = Worksheets("KTL") ' this is the same as sh2
Set sh6 = Worksheets("LCS_KTL AI Diff")
Set rng3 = sh1.Range(sh1.Cells(2, 2), sh1.Cells(2, 2).End(xlDown))

'--I need to know if the cell above (2) if it is higher than cell (10) below

Set rng4 = sh2.Range(sh2.Cells(2, 10), sh2.Cells(2, 10).End(xlDown))

' is this sh2 or sh5 ? seems to be different sheets
if sh1.Cells(2, 2) sh2.Cells(2, 10) then
' do something
end if
'-- If yes then copy and paste into sh6

If Application.CountIf(rng4, cell.Value) = 0 Then
cell.EntireRow.Copy sh6.Cells(rw, 1)
rw = rw + 1
End If

End If
Next

Range("A1").Select ' what sheet is this on..
Columns("A:O").EntireColumn.AutoFit
End Sub

--
Hope this helps
Martin Fishlock, Bangkok, Thailand
Please do not forget to rate this reply.


"Les" wrote:

Hi all, i have the code below which i got off a site. I have changed it to
suit me but i need help with the second part.. I have put comments in the
code below.

Sub Test2()
'
Dim todaysDateLong As String
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim sh4 As Worksheet, sh5 As Worksheet, sh6 As Worksheet
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Dim rw As Long, cell As Range

ActiveWorkbook.Worksheets("PU0703LCS").Rows("1:1") .Copy
ActiveWorkbook.Worksheets.Add(Befo=ActiveSheet) .Name = "LCS_KTL AI
Diff"
ActiveSheet.Paste

Set sh1 = Worksheets("PU0703LCS")
Set sh2 = Worksheets("KTL")
rw = 2
Set rng1 = sh1.Range(sh1.Cells(2, 1), sh1.Cells(2, 1).End(xlDown))
Set rng2 = sh2.Range(sh2.Cells(2, 1), sh2.Cells(2, 1).End(xlDown))
For Each cell In rng1
If Application.CountIf(rng2, cell.Value) = 0 Then

Else
Set sh4 = Worksheets("PU0703LCS")
Set sh5 = Worksheets("KTL")
Set sh6 = Worksheets("LCS_KTL AI Diff")
Set rng3 = sh4.Range(sh4.Cells(2, 2), sh4.Cells(2, 2).End(xlDown))

'--I need to know if the cell above (2) if it is higher than cell (10) below

Set rng4 = sh2.Range(sh5.Cells(2, 10), sh5.Cells(2, 10).End(xlDown))

'-- If yes then copy and paste into sh6

If Application.CountIf(rng4, cell.Value) = 0 Then
cell.EntireRow.Copy sh6.Cells(rw, 1)
rw = rw + 1
End If

End If
Next

Range("A1").Select
Columns("A:O").EntireColumn.AutoFit
End Sub

--
Les