VBA for Ordering List

[jay_hl]

Hello

I have a large table containing 5000 products down the left side, and 100 stores across the top. The number in the table, is the quality of products to order for that particular store.

To upload the order to the system I need a flat list of only those items which need ordering. I have given simplified structures of both the input matrix, and output needed. (PCS is always the same and standard).

Hope someone can help produce something which creates the example in columns J to M

Thanks in advance

Jay

 

[jay_hl]

@jay_hl, try this:
I put the result in sheet2.

Sub jay_hl_1()
Dim i As Long, j As Long, n As Long, k As Long, p As Long
Dim va, vb, vc

n = Range("A" & Rows.Count).End(xlUp).Row
va = Range("A5:A" & n)
p = Cells(5, "CO").End(xlToLeft).Column
vb = Range(Cells(5, "BF"), Cells(n, p))
ReDim vc(1 To 500000, 1 To 4)
For j = 1 To UBound(vb, 2)
    For i = 2 To UBound(vb, 1)
        If vb(i, j) > 0 Then
            k = k + 1
            vc(k, 1) = vb(1, j)
            vc(k, 2) = va(i, 1)
            vc(k, 3) = "PCS"
            vc(k, 4) = vb(i, j)
        End If
    Next
Next

'put the result in sheet2
Sheets("Sheet2").Activate
Range("A:D").ClearContents
Range("A3").Resize(k, 4) = vc

End Sub

In your example in post #9, Range H5:K5 is really blank, right? there is no word "(blank)" in it?

Thanks so much. This works really well, apart from one challenge, which is that it only seems to work for the first store.

I think thats because the variable p isnt setting the right end column, because it seems store name headers are "" and not really truley empty cells. Is there a change we can set p to equal alphanumberic characters, or a length over 2 characters or something like that?

 

[Akuini]

I think thats because the variable p isnt setting the right end column, because it seems store name headers are "" and not really truley empty cells.

Are you saying store name headers are result of formula?

 

[jay_hl]

Are you saying store name headers are result of formula?

Yes. =IF(G$5="","",G$5)

 

[Akuini]

Try this one:

Sub jay_hl_2()
Dim i As Long, j As Long, n As Long, k As Long, p As Long
Dim va, vb, vc
'BF5:CN5
n = Range("A" & Rows.Count).End(xlUp).Row
va = Range("A5:A" & n)
p = Range("BF5:CN5").Find(What:="*", LookIn:=xlValues, lookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Column

vb = Range(Cells(5, "BF"), Cells(n, p))
ReDim vc(1 To 500000, 1 To 4)
For j = 1 To UBound(vb, 2)
    For i = 2 To UBound(vb, 1)
        If vb(i, j) > 0 Then
            k = k + 1
            vc(k, 1) = vb(1, j)
            vc(k, 2) = va(i, 1)
            vc(k, 3) = "PCS"
            vc(k, 4) = vb(i, j)
        End If
    Next
Next

'put the result in sheet2
Sheets("Sheet2").Activate
Range("A:D").ClearContents
Range("A3").Resize(k, 4) = vc

End Sub

 

[jay_hl]

Try this one:

Sub jay_hl_2()
Dim i As Long, j As Long, n As Long, k As Long, p As Long
Dim va, vb, vc
'BF5:CN5
n = Range("A" & Rows.Count).End(xlUp).Row
va = Range("A5:A" & n)
p = Range("BF5:CN5").Find(What:="*", LookIn:=xlValues, lookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Column

vb = Range(Cells(5, "BF"), Cells(n, p))
ReDim vc(1 To 500000, 1 To 4)
For j = 1 To UBound(vb, 2)
    For i = 2 To UBound(vb, 1)
        If vb(i, j) > 0 Then
            k = k + 1
            vc(k, 1) = vb(1, j)
            vc(k, 2) = va(i, 1)
            vc(k, 3) = "PCS"
            vc(k, 4) = vb(i, j)
        End If
    Next
Next

'put the result in sheet2
Sheets("Sheet2").Activate
Range("A:D").ClearContents
Range("A3").Resize(k, 4) = vc

End Sub

This works amazingly well. Thanks so much.

Jay

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.