Change the values of a sheet based on negative and positive calculation of another sheet

[Jyotirmaya]

I have 4 sheets, Sheet1, Sheet2, Temp, Base Price

in sheet1 I have 2 columns Product code and Values, In sheet2 also I have 2 columns Product code and Values, In sheet1 A column a same product may be there for more than one time with different values but in sheet2 the product code is there only for once without having any repetitions

I want the Sheet1 values should change based on the values of Sheet2

Sheet 1 & Sheet 2

Case 1
I want that in sheet2 when the sum of positive is more than the sum of negative then the negative values total should deduct from Sheet 1 Values, in this case -5 should deduct from Sheet 1 of Product code 2, as it will check the sum of product code 2 from sheet1 in this case its 7(B3)+7(B4)= 14 hence it should deduct 5 & it can deduct the 5 towards downwards on the column so after deduction of 5 in B3 of sheet1 will be 2 and B4 should be as usual 7.

Similarly in case of product code 4 it should deduct 20 from B6 of sheet1 and the result should be 11 in B6 in Sheet1 after deduction.
If the sum of positives and negatives are equal then case 1 formula will applicable it will deduct the sum of negative from the values in sheet 1

Case 2

Sheet 1 & Sheet 2

If the maximum value in sheet1 is not greater than the value to be deducted then in the above case I have to deduct 25 from higher values to lowers, hence in the above case, I have to deduct 25, based on the values of Base Price sheet. In the base price sheet, I have values fixed for product code 4 is 6 and for product code 2 is 1. It means in sheet1 product code 4 it must have value 6, it can not be zero and in product code 2 it must have value 1. so in this case we need to deduct 25, so in Sheet1 it will check the values from max to min so its 20 for product code 4 (B6+B7) and for product code 4 base price is 6 so it can deduct 14 from there so B6 should be zero and B7 should be the rest 6. we have deducted 14 and the rest 11 we need to deduct from product code 2 and the base price is 1 and sum of product code is 14 (B3+B4) so it can deduct up to 13 but we need to deduct 11 only so B3 will be zero and B4 should be 3.

Base Price sheet

Finally I want the result like this



I am getting correct results with the below code in case of case 1

Earlier with the below code I was doing calculations without the Base price sheet hence I was getting error, I want to add the Base price sheet details in the calculation, so that I can get the desired result.

What should be the change in the code ?

  Sub DAM_Change_Values()
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, s1 As Double, s2 
  As Double
  Dim v As Range, c As Range, r As Range, f As Range, cell As String
  Dim ded As Double, wmax As Double, col As Long, fila As Long, n As Long
  Dim lr As Long, newv As Range, newded As Variant


 Set sh1 = Sheets("Sheet1")
 Set sh2 = Sheets("Sheet2")
 Set r = sh1.Range("A2", sh1.Range("A" & Rows.Count).End(xlUp))


 For col = Columns("B").Column To Columns("B").Column
 Set v = sh2.Range(sh2.Cells(2, col), sh2.Cells(Rows.Count, col).End(xlUp))


s1 = WorksheetFunction.SumIf(v, ">0")
s2 = Abs(WorksheetFunction.SumIf(v, "<0"))
If s1 >= s2 Then
  'POSITIVE
  For Each c In v
    If c < 0 Then
      ded = Abs(c)
      Set f = r.Find(sh2.Cells(c.Row, "A"), , xlValues, xlWhole)
      If Not f Is Nothing Then
        cell = f.Address
        Do
          If f.Offset(, col - 1) >= ded Then
            f.Offset(, col - 1) = f.Offset(, col - 1) - ded
            Exit Do
          Else
            ded = ded - f.Offset(, col - 1)
            f.Offset(, col - 1) = 0
          End If
          Set f = r.FindNext(f)
        Loop While Not f Is Nothing And f.Address <> cell
      End If
    End If
  Next
Else
  'NEGATIVE
  n = 1
  Set sh3 = Sheets("Temp")
  sh3.Cells.Clear
  newded = s1
  lr = 1
  For Each c In v
    If c < 0 Then
      sh3.Cells(lr, "A") = c
      sh3.Cells(lr, "B") = sh2.Cells(c.Row, "A")
      lr = lr + 1
    End If
  Next


  sh3.Range("A1:B" & lr).Sort key1:=sh3.Range("A1"), order1:=xlAscending, Header:=xlNo
  Set newv = sh3.Range("A1:A" & lr - 1)


  For Each c In newv
    If Abs(c) >= newded Then
      c = newded * -1
    Else
      newded = newded - Abs(c)
    End If
  Next


  For Each c In newv
   ded = Abs(c)
   Set f = r.Find(c.Offset(, 1), , xlValues, xlWhole)
   If Not f Is Nothing Then
     cell = f.Address
     Do
        If f.Offset(, col - 1) >= ded Then
          f.Offset(, col - 1) = f.Offset(, col - 1) - ded
          Exit Do
        Else
          ded = ded - f.Offset(, col - 1)
          f.Offset(, col - 1) = 0
        End If
       Set f = r.FindNext(f)
     Loop While Not f Is Nothing And f.Address <> cell
   End If
  Next
 End If
 Next
 MsgBox "End"
 End Sub