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.

 

[jay_hl]

Hello

Ive been using your code, and have now adapted it to a new set up, which was working really when the array is formed as single continuous list. However there are two improvements that I need to make around formatting that I cant get to work. So wonder if you could help.

The first change is rather than a continuous list across all rows, I need the output as 4 "tables". When the value in the first column changes (e.g from Store 1 to Store 2) I need to insert two blank rows and then the the Header Row, which is hard coded in the first line of the array.

The second change if that I need to create a blank row, when the value in the second column changes.

I have pasted my current code below, but wondered if I can get some help with what im trying to achieve. There is also a screenshot of what I an trying to achieve with sample data.

Dim i As Long, j As Long, n As Long, k As Long, p As Long, q As Long
Dim va, vb, vc, vd, ve, vf, vg, vk
n = Range("A" & Rows.Count).End(xlUp).Row
va = Range("A5:A" & n)
vb = Range("B5:B" & n)
vc = Range("C5:C" & n)
p = Range("A1:BZ1").Find(What:="Output", LookIn:=xlValues, lookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Column
q = Range("A1:BZ1").Find(What:="Output", LookIn:=xlValues, lookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Column

ve = Range(Cells(3, p), Cells(3, q))
vf = Range(Cells(4, p), Cells(4, q))
vg = Range(Cells(5, p), Cells(n, q))

ReDim vk(1 To 1000000, 1 To 6)
For j = 1 To UBound(vg, 2)
            vk(1, 1) = "Move From"
            vk(1, 2) = "Move To"
            vk(1, 3) = "SKU"
            vk(1, 4) = "Barcode"
            vk(1, 5) = "Description"
            vk(1, 6) = "Quantity to Transfer"
    For i = 2 To UBound(vg, 1)
        If vg(i, j) <> "" Then
            k = k + 1
            vk(k, 1) = ve(1, j)
            vk(k, 2) = vf(1, j)
            vk(k, 3) = va(i, 1)
            vk(k, 4) = vb(i, 1)
            vk(k, 5) = vc(i, 1)
            vk(k, 6) = vg(i, j)
        End If
    Next
Next

Appreciate the help

Jay

 

[jay_hl]

What im trying to achieve

 

[Akuini]

Could you please provide some example data along with the expected results? Please use the XL2BB tool to post your example, so we don't have to retype it.

OR

Could you please upload a sample workbook to a file-sharing site like Dropbox or Google Drive and share the link here? Also, ensure that the link is accessible to anyone. If there is sensitive data, please replace it with representative dummy data. And please also provide the expected results.

 

[jay_hl]

Move From	Move To	SKU	Barcode	Description	Quantity to Transfer
Store 1	Store 2	1	1875067953400	Desc 1	10
Store 1	Store 2	2	5084518301741	Desc 2	10
Store 1	Store 3	3	4799819599110	Desc 3	6
Store 1	Store 3	4	6599293610642	Desc 4	6
Store 1	Store 4	5	3706617638861	Desc 6	6
Store 1	Store 4	6	9613100809367	Desc 7	15
Store 1	Store 4	7	2632382363493	Desc 8	8
Store 1	Store 4	8	3767648862077	Desc 9	8
Store 1	Store 4	9	8542774622658	Desc 10	8
Store 1	Store 4	10	6340813069086	Desc 11	14
Store 1	Store 4	11	8559955993466	Desc 12	7
Store 1	Store 4	12	4648033359110	Desc 13	17
Store 1	Store 4	13	8264023743408	Desc 14	10
Move From	Move To	SKU	Barcode	Description	Quantity to Transfer
Store 2	Store 1	1	3588712844609	Desc 1	12
Store 2	Store 3	2	3585632196472	Desc 2	6
Store 2	Store 3	3	9594754496193	Desc 3	6
Store 2	Store 4	4	1642495585470	Desc 4	12
Store 2	Store 4	6	5678830664994	Desc 5	15
Store 2	Store 4	7	7014042320179	Desc 6	7