Thanks for immediate response!
Actually I am trying to summerize data thru matching certain conditions like
Op. Stock as on the cutoff date/time & recpts onwards from that cutoff date,
less issuance onwards from cutoff date/time & despatches onwards from cutoff
date/time.
The below mentioned is the codes which i am trying. This will give you
better idea.
Kindly respond.
Sub MyMacro1()
'Dim rngE, rngB, rngJ As Range
'Dim s, m, T, n, u, o As Variant
'Dim RequestedDate As Date
'Dim LastRow As Long
'Dim r, d, p, e As String
Dim opstk As Date
d = "'Desp'!"
p = "'PhyStk'!"
e = "'Issue'!"
r = "'Recpt'!"
For Each partno In Worksheets("LookupLists").Range("PartIdList")
With sheets("PhyStk")
Set c = .Columns(2).Find(What:=partno, _
LookIn:=xlValues, LookAt:=xlWhole)
If c Is Nothing Then
MsgBox ("Error: Cannot find Part no : " & partno)
Else
partrow = c.Row
opstk = .Cells(partrow, "A").Value
qty = .Cells(partrow, "J").Value
End If
opstk = CDbl(opstk)
End With
With sheets("Recpt")
LastRow = .Cells(Rows.Count, 1) _
.End(xlUp).Offset(0, 0).Row
Set rngE = .Range("F2:F" & LastRow)
Set rngB = .Range("B2:B" & LastRow)
Set rngJ = .Range("G2:G" & LastRow)
On Error GoTo 0
s = "Sumproduct((" & r & rngE.Address & "=""" & partno & """)*"
& _
"(" & r & rngB.Address & ">=" & CDbl(opstk) & ")," & _
"(" & r & rngJ.Address & "))"
MsgBox s
m = Evaluate(s)
End With
With sheets("Issue")
LastRow = .Cells(Rows.Count, 1) _
.End(xlUp).Offset(0, 0).Row
Set rngE = .Range("D2
" & LastRow)
Set rngB = .Range("B2:B" & LastRow)
Set rngJ = .Range("F2:F" & LastRow)
On Error GoTo 0
t = "Sumproduct((" & e & rngE.Address & "=""" & partno & """)*"
& _
"(" & e & rngB.Address & ">=" & CDbl(opstk) & ")," & _
"(" & e & rngJ.Address & "))"
n = Evaluate(t)
End With
With sheets("Desp")
LastRow = .Cells(Rows.Count, 1) _
.End(xlUp).Offset(0, 0).Row
Set rngE = .Range("E2:E" & LastRow)
Set rngB = .Range("B2:B" & LastRow)
Set rngJ = .Range("J2:J" & LastRow)
On Error GoTo 0
u = "Sumproduct((" & d & rngE.Address & "=""" & partno & """)*"
& _
"(" & d & rngB.Address & ">=" & CDbl(opstk) & ")," & _
"(" & d & rngJ.Address & "))"
o = Evaluate(u)
End With
' MsgBox "OpStk as on : " & qty & " Pur. : " & m & _
" Issue : " & n & " Desp. : " & o
' MsgBox ((qty + m) - (n + o))
With Worksheets("StockList")
Set c = .Rows(1).Find(What:="System Stock", _
LookIn:=xlValues, LookAt:=xlWhole)
If c Is Nothing Then
MsgBox ("Error: Cannot find column : System Stock !")
'.Cells(1, NewCol) = class
'ClassCol = NewCol
'NewCol = NewCol + 1
'Exit Sub
Resume Next
Else
refcol = c.Column
End If
Set c = .Columns(2).Find(What:=partno, _
LookIn:=xlValues, LookAt:=xlWhole)
If c Is Nothing Then
'MsgBox ("Error: Cannot find column : Part No : ! " & partno)
On Error Resume Next
'Call Trial
Else
refrow = c.Row
Cells(refrow, refcol).Value = ((qty + m) - (n + o))
End If
'n = Cells(Rows.Count, refcol).End(xlUp).Row
End With
Next partno
End Sub
--
Thanks,
Vikram P. Dhemare
Mike H said:
Hi,
I'm a bit unsure of this. The ranges you are setting in you code seem to
bear no relation to the ranges of your data. In any case I wouldn't use a
worksheet function in Vb to do this. Try this instead
Note because I don't know eher you get opstk and partno from for this code I
read them from the worksheet.
Sub standard()
Dim opstk As Date
opstk = Range("D1").Value
partno = Range("D2").Value
LastRow = Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
Set rnga = Range("A2:A" & LastRow)
For Each c In rnga
If IsDate(c) And c.Value = opstk And c.Offset(, 1).Value = partno Then
s = s + c.Offset(, 2).Value
End If
Next
MsgBox s
End Sub
Mike
Awaiting your reply.
