Some pretty itensive code needed

[Hozz]

I currently have a list of stock in a table (in sheet2). The table is sorted by column a then column e, so all same stock codes are together and then the highest to lowest numbers of stock per bin are shown.
Column A contains product code,
Columns b-d are various descriptions
column e shows how many of the product are stored in a bin.

There are many cases in the list where the stock is in more than one bin and can be consilidated into just one bin. Depending on the stock, it can be spread over up to 20 bins.
I want the code to produce a list for me (in sheet3) that will show what bins can be consilidated. This will save me going through a list manually which can be up to 8000 lines long.

So establish the max amount of stock of a certain item a bin can hold, the code would have to look for the maximum value in column e per stock code(column a).
Once this is done, all bins that contain 50% or less stock than the max amount should be copied into the new list.
If there are any cases where the stock can not be consolidated (ie, 2 bins of stock, each with 2 items in each bin, or 3 items in a bin and 1 or 2 in another) then these should be removed from the list.

Is this possible? If it is, would someone be kind enough to write it for me as this is way beyong my meager knowledge of VBA. Thanks

 

[Gerald Higgins]

deleted

 

[al_b_cnu]

Hi Hozz,

Here's a VBA solution:

Option Explicit
Dim mvaData() As Variant
Const miProductCol As Integer = 1
Const miDescCol As Integer = 2
Const miCountCol As Integer = 6

Sub BinThereDoneThat()
Dim dblTriggerCount As Double
Dim iCol As Integer
Dim lRowEnd As Long, lRow As Long, lOutputRow As Long, lPtr As Long
Dim lMaxCount As Long, lCurCount As Long, lStartRow As Long
Dim sPrev As String, sCur As String
Dim vaOutputLine() As Variant
Dim wsFrom As Worksheet, wsTo As Worksheet

Set wsFrom = Sheets("Sheet2")
Set wsTo = Sheets("Sheet3")

wsTo.UsedRange.ClearContents

ReDim vaOutputLine(1 To 1, 1 To miCountCol)

lRowEnd = wsFrom.Cells(Rows.Count, "A").End(xlUp).Row + 1
lOutputRow = 0
If lRowEnd > 1 Then
    mvaData = wsFrom.Range("A1", Cells(lRowEnd, miCountCol).Address).Value
    sPrev = ""
    lMaxCount = 0
    lStartRow = 1
    For lRow = 2 To lRowEnd
        sCur = Trim$(CStr(mvaData(lRow, miProductCol)))
        If sCur <> sPrev Then
            sPrev = sCur
            dblTriggerCount = lMaxCount / 2
            For lPtr = lStartRow To lRow - 1
                If Val(mvaData(lPtr, miCountCol)) <= dblTriggerCount Then
                    For iCol = miProductCol To miCountCol
                        vaOutputLine(1, iCol) = mvaData(lPtr, iCol)
                    Next iCol
                    lOutputRow = lOutputRow + 1
                    wsTo.Range("A" & lOutputRow, _
                               Cells(lOutputRow, miCountCol).Address).Value _
                                    = vaOutputLine
                End If
            Next lPtr
            lMaxCount = Val(mvaData(lRow, miCountCol))
            lStartRow = lRow
        Else
            lCurCount = Val(mvaData(lRow, miCountCol))
            If lCurCount > lMaxCount Then lMaxCount = lCurCount
        End If
    Next lRow
End If

End Sub

 

[Gerald Higgins]

=IF(E2< ROUND(F2/2,0),"consolidate","don't consolidate")

Here goes again . . .

 

[Gerald Higgins]

Ah that's it. Thanks to Richard Schollar for pointing out what I needed to do to get this to work. Hozz, if you use this, note that I have had to insert a space before the word ROUND, so if you want to copy the formula directly into your spreadsheet, delete that space.