R
Ren
Hi i have 3 sheets,
this is the code which is running,first cycle is ok. but when the item
repeats ie second time when the item comes, i want the control to goto the
balace column ie d.offset(0,3) or c.offset(0,4) to fetch the data.and insert
a row to add the quantity and balance. in sheet2 and sheet3
Sub alloc()
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
Set d = sh3range.Find( _
what:=sh1cell, LookIn:=xlValues)
If d Is Nothing Then
sh1cell.Interior.ColorIndex = 5
'(if the item is found then do the following actions)
Else: sh1cell.Interior.ColorIndex = xlNone
If sh1cell.Offset(0, 2) < d.Offset(0, 2) Then
d.Offset(0, 4).Value = sh1cell.Offset(0, -1)
ElseIf sh1cell.Offset(0, 3) > d.Offset(0, 2) Then
d.Offset(0, 4).Value = sh1cell.Offset(0, -1)
End If
End If
'(if the item is found then do the following actions)
ElseIf sh1cell.Offset(0, 2) < c.Offset(0, 3) Then
c.Offset(0, 5).Value = sh1cell.Offset(0, -1)
ElseIf sh1cell.Offset(0, 2) > c.Offset(0, 3) Then
c.Offset(0, 6).Value = sh1cell.Offset(0, 3)
End If
'(if the required qty is not enough then goto sheet3)
'(else goto sheet1 to get the new item)
Next sh1cell
End Sub
thanks
this is the code which is running,first cycle is ok. but when the item
repeats ie second time when the item comes, i want the control to goto the
balace column ie d.offset(0,3) or c.offset(0,4) to fetch the data.and insert
a row to add the quantity and balance. in sheet2 and sheet3
Sub alloc()
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
Set d = sh3range.Find( _
what:=sh1cell, LookIn:=xlValues)
If d Is Nothing Then
sh1cell.Interior.ColorIndex = 5
'(if the item is found then do the following actions)
Else: sh1cell.Interior.ColorIndex = xlNone
If sh1cell.Offset(0, 2) < d.Offset(0, 2) Then
d.Offset(0, 4).Value = sh1cell.Offset(0, -1)
ElseIf sh1cell.Offset(0, 3) > d.Offset(0, 2) Then
d.Offset(0, 4).Value = sh1cell.Offset(0, -1)
End If
End If
'(if the item is found then do the following actions)
ElseIf sh1cell.Offset(0, 2) < c.Offset(0, 3) Then
c.Offset(0, 5).Value = sh1cell.Offset(0, -1)
ElseIf sh1cell.Offset(0, 2) > c.Offset(0, 3) Then
c.Offset(0, 6).Value = sh1cell.Offset(0, 3)
End If
'(if the required qty is not enough then goto sheet3)
'(else goto sheet1 to get the new item)
Next sh1cell
End Sub
thanks