Sub J3v16()
Dim X, Chk As Boolean, ws As Worksheet, Txn As String
Dim nr As Long, lr As Long, i As Long, ii As Long, Valu As Long, Tot As Long
Application.ScreenUpdating = False
For Each ws In Sheets(Array("Purchase", "Sales", "Returns Purchase", "Returns Sales "))
With ws
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
If lr > 19 Then
.Range("B20:G" & lr).Copy
With Sheets("Data ")
nr = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
If Chk = False Then ii = nr: Chk = True
.Range("D" & nr).PasteSpecial xlPasteValues
.Range("A" & nr).Resize(lr - 19) = ws.Range("A20:A" & lr).Value
.Range("B" & nr).Resize(lr - 19, 2) = Array(ws.Range("G3"), ws.Range("G4"))
.Range("J" & nr).Value = Application.Sum(.Range("I" & nr).Resize(lr - 19))
End With
End If
End With
Next ws
With Sheets("Data ")
.UsedRange.Borders.Weight = 2
.Columns(7).Resize(, 4).NumberFormat = "0.00"
For i = ii To .Cells(.Rows.Count, 1).End(xlUp).Row
Txn = Evaluate("=LEFT(""" & .Range("B" & i) & """,FIND(""-"",""" & .Range("B" & i) & """)-1)")
Valu = .Range("G" & i)
With Sheets("Stock")
X = Application.Match(Sheets("Data ").Range("D" & i), .Range("B:B"), 0)
If Not IsError(X) Then
Tot = IIf(Txn = "PUR", Valu, IIf(Txn = "SALE", Valu * -1, IIf(Txn = "RSALE", Valu * -1, IIf(Txn = "RPUR", Valu, ""))))
.Range("E" & X) = .Range("E" & X) + Tot
End If
End With
Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Bookmarks