ExcelBanter - nested for each or something else??

I split your code into two subroutines anbd put sh3range as a public variable.

Dim sh3range As Range

Sub allocation2()
Dim sh1range As Range
Dim sh2range As Range
Dim sh1cell As Range
Dim r1cell As Range

With Sheets("polist")
Set sh1range = .Range("F2:F" & .Cells(Rows.Count, "F").End(xlUp).Row)
End With

With Sheets("slrs")
Set sh2range = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
End With

With Sheets("FAB")
Set sh3range = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
End With

For Each sh1cell In sh1range
Set c = sh2range.Find( _
what:=sh1cell, LookIn:=xlValues)
If c Is Nothing Then

sh1cell.Interior.ColorIndex = 4

'(control should go and search the item in sheet3)
Call Sh3find(sh1cell)

'(if the item is found then do the following actions)
ElseIf sh1cell.Offset(0, 2) < c.Offset(0, 3) Then
sh1cell.Offset(0, 3).Value = sh1cell.Offset(0, 2)
c.Offset(0, 6).Value = sh1cell.Offset(0, 2)
c.Offset(0, 4).FormulaR1C1 = "=RC[-1]-RC[2]"
c.Offset(0, 5).Value = sh1cell.Offset(0, -3)
ElseIf sh1cell.Offset(0, 2) c.Offset(0, 3) Then
sh1cell.Offset(0, 3).Value = c.Offset(0, 3)
c.Offset(0, 6).Value = sh1cell.Offset(0, 3)
Sheets("slrs").Range("G:G").NumberFormat = "0;[Red]0"
c.Offset(0, 4).FormulaR1C1 = "=RC[-1]-RC[2]"
c.Offset(0, 5).Value = sh1cell.Offset(0, -3)
Sheets("slrs").Range("F:F").NumberFormat = "0;[Red]0"
Range("F:F").ColumnWidth = 18

End If

'(if the required qty is not enough then goto sheet3)
'(else goto sheet1 to get the new item)

Next sh1cell

End Sub

Sub Sh3find(r1cell As Range)

Set d = sh3range.Find( _
what:=r1cell.Value, LookIn:=xlValues)

If d Is Nothing Then

r1cell.Interior.ColorIndex = 5

'(if the item is found then do the following actions)

ElseIf r1cell.Offset(0, 2) < d.Offset(0, 2) Then
r1cell.Offset(0, 5).Value = r1cell.Offset(0, 3)
r1cell.Offset(0, 6).Value = d.Offset(0, 1)
d.Offset(0, 5).Value = r1cell.Offset(0, 5)
d.Offset(0, 3).FormulaR1C1 = "=RC[-1]-RC[2]"
d.Offset(0, 4).Value = r1cell.Offset(0, -3)
ElseIf r1cell.Offset(0, 3) d.Offset(0, 2) Then
r1cell.Offset(0, 5).Value = d.Offset(0, 2)
r1cell.Offset(0, 6).Value = d.Offset(0, 1)
d.Offset(0, 5).Value = r1cell.Offset(0, 5)
d.Offset(0, 3).FormulaR1C1 = "=RC[-1]-RC[2]"
d.Offset(0, 4).Value = r1cell.Offset(0, -3)

End If

End Sub

"Ren" wrote:

Hi, I have 3 sheets
sheet1 (orderno,items,required quantity etc)
sheet2(items,store1,store2,total)
sheet3(item,ETA,totalquantity)

I need to find out whether the item is present in sheet2,
if the item is present in sheet2,take the quntity and put it in sheet1(pl
see the code)
(if the quantity is not sufficient or the item is not present in sheet2
then goto sheet3 to find the item)
if the quantity is sufficient enough then goto sheet1 for the nextcell
if the item is present in sheet3 then do the activities(see the code)
if the item is not present then goto sheet1 for the nextcell.

the code is like this,but i donno how to do this.
segmentwise it works but when i put it together it's not working.

i donno how to use the control.
pl help me.here is the code
For each is ok?? or should i use something else to write the macro??
Sub allocation2()
Dim sh1range As Range
Dim sh2range As Range
Dim sh3range As Range
Dim sh1cell As Range
Dim r1cell As Range

With Sheets("polist")
Set sh1range = .Range("F2:F" & .Cells(Rows.Count, "F").End(xlUp).Row)
End With

With Sheets("slrs")
Set sh2range = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
End With

With Sheets("FAB")
Set sh3range = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
End With

For Each sh1cell In sh1range
Set c = sh2range.Find( _
what:=sh1cell, LookIn:=xlValues)
If c Is Nothing Then

sh1cell.Interior.ColorIndex = 4

'(control should go and search the item in sheet3)
GoTo nextsheet '(pl look at the bottom of the code for nextsheet)

'(if the item is found then do the following actions)
ElseIf sh1cell.Offset(0, 2) < c.Offset(0, 3) Then
sh1cell.Offset(0, 3).Value = sh1cell.Offset(0, 2)
c.Offset(0, 6).Value = sh1cell.Offset(0, 2)
c.Offset(0, 4).FormulaR1C1 = "=RC[-1]-RC[2]"
c.Offset(0, 5).Value = sh1cell.Offset(0, -3)
ElseIf sh1cell.Offset(0, 2) c.Offset(0, 3) Then
sh1cell.Offset(0, 3).Value = c.Offset(0, 3)
c.Offset(0, 6).Value = sh1cell.Offset(0, 3)
Sheets("slrs").Range("G:G").NumberFormat = "0;[Red]0"
c.Offset(0, 4).FormulaR1C1 = "=RC[-1]-RC[2]"
c.Offset(0, 5).Value = sh1cell.Offset(0, -3)
Sheets("slrs").Range("F:F").NumberFormat = "0;[Red]0"
Range("F:F").ColumnWidth = 18

End If

'(if the required qty is not enough then goto sheet3)
'(else goto sheet1 to get the new item)

Next sh1cell

nextsheet:

For Each r1cell In sh1range
Set d = sh3range.Find( _
what:=r1cell, LookIn:=xlValues)

If d Is Nothing Then

r1cell.Interior.ColorIndex = 5
GoTo nextsh1cell '(if the item is not found then goto sh1cell)

'(if the item is found then do the following actions)

ElseIf r1cell.Offset(0, 2) < d.Offset(0, 2) Then
r1cell.Offset(0, 5).Value = r1cell.Offset(0, 3)
r1cell.Offset(0, 6).Value = d.Offset(0, 1)
d.Offset(0, 5).Value = r1cell.Offset(0, 5)
d.Offset(0, 3).FormulaR1C1 = "=RC[-1]-RC[2]"
d.Offset(0, 4).Value = r1cell.Offset(0, -3)
ElseIf r1cell.Offset(0, 3) d.Offset(0, 2) Then
r1cell.Offset(0, 5).Value = d.Offset(0, 2)
r1cell.Offset(0, 6).Value = d.Offset(0, 1)
d.Offset(0, 5).Value = r1cell.Offset(0, 5)
d.Offset(0, 3).FormulaR1C1 = "=RC[-1]-RC[2]"
d.Offset(0, 4).Value = r1cell.Offset(0, -3)

End If
Next sh1cell '(control should goto sheet1 to take the next item)

End Sub