Adjust Qty of a sheet material total from other sheet same

[RENU1973]

I want to adjust the each Material's total of sheet "131" from the sheet "261".
Refer my attach file.
In this file,summary sheet is the total of Quantity of each material of 'MVT' 131 and 261 from both sheets.Now,I want to adjust the total of material sheet '131' from the total of sheet '261'.Look up from last descending order the total of sheet '261'of a material quantity and change the Quantity of first descending order from original one to difference of sheet "131" material quantity. And finally,unwanted rows should delete.If any material Quantity total of sheet '261' is less than from the total of sheet '131' then no need to adjustment.

For an example,take material code 'A'.Sheet '131' total Quantity of 'A' is 828 and sheet '261' is 1471.Keep the total quantity of 828 from sheet '261' of 'A' Material from the descending orders date and adjust the last descending order date Quantity diff..For more clarity,please refer attach file and sheet 'Result'.Only 'Bold' rows should be kept and delete the 'Red' font colour rows.

[HansV]

Try this macro:

Code: Select all

Sub AdjustQty()
    Const lngFirstRow = 5 ' First row with data
    Const lngTMatCol = 9 ' I = Material column on data sheets
    Const lngTQtyCol = 11 ' K = Quantity column on data sheets
    Const lngSMatCol = 2 ' B = Material column on summary sheet
    Const lngSDifCol = 5 ' E = Difference column on summary sheet
    Dim wshTrg As Worksheet
    Dim wshSum As Worksheet
    Dim lngRow As Long
    Dim strMaterial As String
    Dim lngSDiff As Long
    Dim lngQty As Long
    Application.ScreenUpdating = False
    Set wshTrg = Worksheets("261")
    Set wshSum = Worksheets("Summary")
    lngRow = lngFirstRow
    Do
        strMaterial = wshTrg.Cells(lngRow, lngTMatCol).Value
        lngQty = wshTrg.Cells(lngRow, lngTQtyCol).Value
        lngSDiff = -wshSum.Columns(lngSMatCol).Find(What:=strMaterial, _
            LookAt:=xlWhole).Offset(ColumnOffset:=lngSDifCol - lngSMatCol).Value
        If lngSDiff > 0 Then
            If lngSDiff > lngQty Then
                wshTrg.Cells(lngRow, lngTMatCol).EntireRow.Delete
            Else
                wshTrg.Cells(lngRow, lngTQtyCol).Value = lngQty - lngSDiff
                lngRow = lngRow + 1
            End If
        Else
            lngRow = lngRow + 1
        End If
    Loop Until wshTrg.Cells(lngRow, lngTMatCol).Value = ""
    Application.ScreenUpdating = True
End Sub

Please test on a copy of your workbook first. If the layout changes, you can modify the constants at the beginning.

[RENU1973]

Thanks Hans for your nice help.

Thanks and Regards

Renu

[HansV]

This version is MUCH faster:

Code: Select all

Sub AdjustQty()
    Const lngFirstRow = 5 ' First row with data
    Const lngTMatCol = 9 ' I = Material column on data sheets
    Const lngTQtyCol = 11 ' K = Quantity column on data sheets
    Const lngSMatCol = 2 ' B = Material column on summary sheet
    Const lngSDifCol = 5 ' E = Difference column on summary sheet
    Dim wshTrg As Worksheet
    Dim wshSum As Worksheet
    Dim lngRow As Long
    Dim strMaterial As String
    Dim strPrevMaterial As String
    Dim lngSDiff As Long
    Dim lngQty As Long
    Dim lngStartRow As Long
    Dim rngToDelete As Range
    Dim blnBusy As Boolean
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Set wshTrg = Worksheets("261")
    Set wshSum = Worksheets("Summary")
    lngRow = lngFirstRow
    Do
        strMaterial = wshTrg.Cells(lngRow, lngTMatCol).Value
        lngQty = wshTrg.Cells(lngRow, lngTQtyCol).Value
        If strMaterial <> strPrevMaterial Then
            lngSDiff = -wshSum.Columns(lngSMatCol).Find(What:=strMaterial, _
                LookAt:=xlWhole).Offset(ColumnOffset:=lngSDifCol - lngSMatCol).Value
            lngStartRow = lngRow
            blnBusy = True
            strPrevMaterial = strMaterial
        End If
        lngSDiff = lngSDiff - lngQty
        If lngSDiff < 0 Then
            If blnBusy And lngRow > lngStartRow Then
                If rngToDelete Is Nothing Then
                    Set rngToDelete = wshTrg.Range("A" & _
                        lngStartRow & ":A" & (lngRow - 1)).EntireRow
                Else
                    Set rngToDelete = Union(rngToDelete, wshTrg.Range("A" & _
                        lngStartRow & ":A" & (lngRow - 1)).EntireRow)
                End If
                wshTrg.Cells(lngRow, lngTQtyCol).Value = -lngSDiff
                blnBusy = False
            End If
        End If
        lngRow = lngRow + 1
    Loop Until wshTrg.Cells(lngRow, lngTMatCol).Value = ""
    If Not rngToDelete Is Nothing Then
        rngToDelete.Delete
    End If
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Again, please test carefully.

[RENU1973]

Yes,it is the best earlier one.Thanks once again for nice and prompt help and cooperation.

Regards

Renu

[HansV]

Hi Renu,

Why did you delete your request to speed up the macro?

[RENU1973]

It has been deleted by my mistake.I am really very sorry for that.Can you add my previous question as I posted?

[HansV]

That's not possible, but if I remember correctly, you mentioned that the macro from my first reply took a very long time when applied to the real data, so you asked whether it could be improved.

[RENU1973]

Yes Hans Sir,It was which you have mentioned in your reply.

[RENU1973]

Good afternoon Hans,

Pl.refer the attach file.In this file I am facing the problem which I have mentioned in my query earlier.Actually,this type of problem is appearing at that time.

I have mentioned earlier as "If any material Quantity total of sheet '261' is less than from the total of sheet '131' then no need to adjustment.But it is ajusting the all total of a material on sheet '131' from sheet '261'.
If a 'material' total on sheet '261' is less than the total of same 'material' on sheet '131' then no adjustment should be perform.

[HansV]

I'll try to find a solution, but it may take a bit of time.

[HansV]

I'm afraid I don't understand the problem. Can you provide concrete examples of why the result is incorrect?

[RENU1973]

Refer my attach file 'Excise1'.Please see the sheet 261-original,'Material' N qty,total sum is 170 ( Cell M6) which is less than the 'material' N on 131 sheet total ( Refer cell no.K17 on 131 sheet ).Now copy the datas of sheet '261-original' on sheet '261'and run the macro.It is adjusting the total of 'material' 131 from total of '261'sheet 'material'.All is well but in case if the 'material' qty sum of '131' is more than the '261' sheet ,then,no adjustment should be perform.Like the case 'Material' N and P .

[HansV]

Try this version of the macro:

Code: Select all

Sub AdjustQty()
    Const lngFirstRow = 5 ' First row with data
    Const lngTMatCol = 9 ' I = Material column on data sheets
    Const lngTQtyCol = 11 ' K = Quantity column on data sheets
    Const lngSMatCol = 2 ' B = Material column on summary sheet
    Const lngSDifCol = 5 ' E = Difference column on summary sheet
    Dim wshTrg As Worksheet
    Dim wshSum As Worksheet
    Dim lngRow As Long
    Dim strMaterial As String
    Dim strPrevMaterial As String
    Dim lngSDiff As Long
    Dim lngQty As Long
    Dim lngStartRow As Long
    Dim rngToDelete As Range
    Dim blnBusy As Boolean
    Dim blnSkip As Boolean
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Set wshTrg = Worksheets("261")
    Set wshSum = Worksheets("Summary")
    lngRow = lngFirstRow
    Do
        strMaterial = wshTrg.Cells(lngRow, lngTMatCol).Value
        lngQty = wshTrg.Cells(lngRow, lngTQtyCol).Value
        If strMaterial <> strPrevMaterial Then
            lngSDiff = -wshSum.Columns(lngSMatCol).Find(What:=strMaterial, _
                LookAt:=xlWhole).Offset(ColumnOffset:=lngSDifCol - lngSMatCol).Value
            blnSkip = (lngSDiff < 0)
            lngStartRow = lngRow
            blnBusy = True
            strPrevMaterial = strMaterial
        End If
        If Not blnSkip Then
            lngSDiff = lngSDiff - lngQty
            If lngSDiff < 0 Then
                If blnBusy And lngRow > lngStartRow Then
                    If rngToDelete Is Nothing Then
                        Set rngToDelete = wshTrg.Range("A" & _
                            lngStartRow & ":A" & (lngRow - 1)).EntireRow
                    Else
                        Set rngToDelete = Union(rngToDelete, wshTrg.Range("A" & _
                            lngStartRow & ":A" & (lngRow - 1)).EntireRow)
                    End If
                    wshTrg.Cells(lngRow, lngTQtyCol).Value = -lngSDiff
                    blnBusy = False
                End If
            End If
        End If
        lngRow = lngRow + 1
    Loop Until wshTrg.Cells(lngRow, lngTMatCol).Value = ""
    If Not rngToDelete Is Nothing Then
        rngToDelete.Delete
    End If
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

[RENU1973]

Thanks Hans,it is my requirement.Very happy to receive it.

Warm Regards and Thanks

Renu