Stock inventory cout with serial numbers sorting query

S

smeeagain1

New Member
Joined
Feb 20, 2014
Messages
9
Hi guys. I have a scanner that scans stock barcodes and serial numbers into a memory chip on the scanner.I then dock the scanner and download the info into excel.
I need to sort the data into 2 columns based on cell contents.

If I scan an item without a serial number, I just want it to stay in column A, however, if I scan a serialized item (ie: scan the barcode and then scan the serial number), I need Excel to take that serial and place it in column B next to the items barcode entry (ie: move the serial up one line and into column B).
Also I need to then remove the blank line from the sheet.
The items scanned have a Product number (denoted by a P-####) when scanned, so I could differentiate the serials and products using this delimiter. Can anyone assist please?
Thanks.


******** type="cosymantecnisbfw" cotype="cs" id="SILOBFWOBJECTID" style="width: 0px; height: 0px; display: block;">******** type="cosymantecnisbfw" cotype="cs" id="SILOBFWOBJECTID" style="width: 0px; height: 0px; display: block;"></object>
 
Sort by date Sort by votes
Try this, where you will call the sub named MyScanA.
(See notes at bottom of sub MyScanA.)


Put this in the sheet module that has the data.

Code: 
Option Explicit
Option Base 1

Sub MyScanA()
'by Claus

Dim LRow As Long
Dim myArr As Variant
Dim arrOut() As Variant
Dim i As Long, j As Long

Dim myCt As Long

LRow = Cells(Rows.Count, 1).End(xlUp).row

myArr = Range("A2:A" & LRow)
myCt = WorksheetFunction.CountIf(Range("A2:A" & LRow), "P" & "*")

j = 1
For i = LBound(myArr) To UBound(myArr)

    ReDim Preserve arrOut(myCt, 2)
    If Left(myArr(i, 1), 1) = "P" Then

        arrOut(j, 1) = myArr(i, 1)

        j = j + 1

    Else
        arrOut(j - 1, 2) = myArr(i, 1)

    End If
Next

Range("A2:B" & LRow).ClearContents

Range("A2").Resize(UBound(arrOut), 2) = arrOut

'/ For final results to show on Sheet 1 col C and D of data sheet.
ReScan1

'/ If you want to see results of MyScanA before running ReScan1
'/ then comment out ReScan1 and call it by another means after viewing MyScanA  results.

End Sub


Put this in a Standard Module... (Insert > Module).

Code: 
Option Explicit
Option Base 1

Sub ReScanA() 'by Claus

Dim LRow As Long
Dim arrIn As Variant
Dim arrOut() As Variant
Dim myArr As Variant
Dim dic As Object
Dim i As Long

LRow = Cells(Rows.Count, 1).End(xlUp).row
arrIn = Range("A2:B" & LRow)
Set dic = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(arrIn, 1)
    dic.Item(arrIn(i, 1)) = arrIn(i, 1)
Next

myArr = dic.items
For i = 0 To UBound(myArr)
    ReDim Preserve arrOut(dic.Count, 2)
    arrOut(i + 1, 1) = myArr(i)
    With WorksheetFunction
        If .VLookup(myArr(i), Range("A2:B" & LRow), 2, 0) = 0 Then
            arrOut(i + 1, 2) = .CountIf(Range("A2:A" & LRow), myArr(i))
        Else
            arrOut(i + 1, 2) = .VLookup(myArr(i), Range("A2:B" & LRow), 2, 0)
        End If
    End With
Next
Range("C2").Resize(dic.Count, 2) = arrOut
End Sub



Howard
 
Upvote 0

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Howard. This works well except if you have a count of a particular P-**** number and one happens to have a serial number. It appears the code dumps the serial number in this case.
Is there any way to move these serialised items to the new columns prior to the count?
Workflow:
1) Move all non-P-**** to column B (as is already done).
2)Move all lines with serials then next to them to columns C & D.
3) Count remainder in column A and consolidate count, putting results into Columns C & D.

Results would look like this:
Note: Total count for P-8901 is 5. (One has a serial number)

​
P-9876ABCDE
1​
P-5678FGRTTTRGF
1​
P-7675HFHFHFH
1​
P-8901ABCDE
1​
P-8901

​
4​
P-3456

​
1​
P-6543

​
2​
P-54463

​
1​

<tbody>
</tbody>



Note1​
 
Last edited:
Upvote 0
Put this in the sheet module.

Code: 
Option Explicit
Option Base 1

Sub MyScanA()
'/ by Claus

Dim LRow As Long
Dim myArr As Variant
Dim arrOut() As Variant
Dim i As Long, j As Long

Dim myCt As Long

LRow = Cells(Rows.Count, 1).End(xlUp).row

myArr = Range("A2:A" & LRow)
myCt = WorksheetFunction.CountIf(Range("A2:A" & LRow), "P" & "*")

j = 1
For i = LBound(myArr) To UBound(myArr)

    ReDim Preserve arrOut(myCt, 2)
    If Left(myArr(i, 1), 1) = "P" Then

        arrOut(j, 1) = myArr(i, 1)

        j = j + 1

    Else
        arrOut(j - 1, 2) = myArr(i, 1)

    End If
Next

Range("A2:B" & LRow).ClearContents

Range("A2").Resize(UBound(arrOut), 2) = arrOut

'
ReScan1
End Sub


And put this in a standard module.

Code: 
Option Explicit

Sub ReScan1()
'/ by Claus
Dim LRow1 As Long, LRow2 As Long
Dim myArr As Variant

With Sheets("Sheet1")
    LRow1 = .Cells(.Rows.Count, 1).End(xlUp).row
    myArr = .Range("A1:B" & LRow1)
End With

With Sheets("Sheet2")
    .Range("A2").Resize(LRow1, 2) = myArr
    .Range("A2:B" & LRow1 + 1).RemoveDuplicates _
        Columns:=Array(1, 2), Header:=xlNo

    LRow2 = .Cells(.Rows.Count, 1).End(xlUp).row
    
    .Range("C2:C" & LRow2).Formula = "=SumProduct(--(Sheet1!" _
      & "$A$1:$A$" & LRow1 & "=A2),--(Sheet1!$B$1:$B$" & LRow1 & "=B2))"

End With
End Sub

Run Sub MyScanA() which will call Sub ReScan1().

You will need a sheet 2, column A, B and C clear for the returned data.
Best if on sheet 1 there are no Headers and on sheet 2 it doesn't matter, put headers if you want.

Howard
 
Upvote 0
Or perhaps it is better for you to have the data processed and shown on sheet 1.

If so then copy this into the sheet module.

Code: 
Option Explicit
Option Base 1

Sub MyScanA1()
'/ by Claus

Dim LRow As Long
Dim MyArr As Variant
Dim MyArr1 As Variant
Dim arrOut() As Variant
Dim i As Long, j As Long
Dim myCt As Long

Range("B:E").ClearContents

LRow = Cells(Rows.Count, 1).End(xlUp).Row

MyArr = Range("A2:A" & LRow)
myCt = WorksheetFunction.CountIf(Range("A2:A" & LRow), "P" & "*")

j = 1
For i = LBound(MyArr) To UBound(MyArr)

    ReDim Preserve arrOut(myCt, 2)
    If Left(MyArr(i, 1), 1) = "P" Then

        arrOut(j, 1) = MyArr(i, 1)

        j = j + 1

    Else
        arrOut(j - 1, 2) = MyArr(i, 1)

    End If
Next

Range("A2:B" & LRow).ClearContents

Range("A2").Resize(UBound(arrOut), 2) = arrOut

'
ReScan

  MyArr1 = Range("C1", Range("E1").End(xlDown)).Value
  Range("A:E").ClearContents
  Range("A1").Resize(UBound(MyArr1, 1), UBound(MyArr1, 2)) = MyArr1

End Sub


And this into a standard module.


Code: 
Option Explicit

Sub ReScan()
Dim LRow1 As Long, LRow2 As Long
Dim arrIn As Variant
Dim arrOut() As Variant
Dim MyArr As Variant
Dim dic As Object
Dim i As Long

'/Modify the sheet name
With Sheets("Sheet1")
    LRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
    arrIn = .Range("A1:B" & LRow1)
    Set dic = CreateObject("Scripting.Dictionary")

    For i = 1 To UBound(arrIn, 1)
        dic.Item(arrIn(i, 1)) = arrIn(i, 1)
    Next

    MyArr = dic.items
    For i = 0 To UBound(MyArr)
        ReDim Preserve arrOut(dic.Count - 1, 1)
        arrOut(i, 0) = MyArr(i)
        arrOut(i, 1) = WorksheetFunction.VLookup(arrOut(i, 0), _
            .Range("A1:B" & LRow1), 2, 0)
    Next
    .Range("C1").Resize(dic.Count, 2) = arrOut
    LRow2 = .Cells(.Rows.Count, 3).End(xlUp).Row
    With .Range("E1:E" & LRow2)
        .Formula = "=SumProduct(--($A$1:$A$" & LRow1 & _
            "=C1),--($B$1:$B$" & LRow1 & "= D1))"
        .Value = .Value
    End With
End With
End Sub

And then run Sub MyScanA1()

Howard
 
Upvote 0
Hi Howard,

This works great on a small amount of data, however, i am getting errors when I dump a real amount of stock scans into tge XLSM sheet.
I get a "Subscript out of range" error.
Almost there.... :)


The data I am using is below:

P-1645
1753502010
P-1645
1753502022
P-4311
1750502068
P-4311
1750502068
P-3122
F3UT2BA000457
P-3122
F3UT3C5000495
P-3122
F3UT3C4000059
P-3123
QBDA1C7000402
P-3123
QBDA1C2000052
P-4860
P-4860
P-4860
P-4860
P-4416
1711502041
P-4318
1711502045
P-4318
1711502045
P-4318
1711502065
P-4688
2BA0613000098
P-3001
1712502052
P-3001
1712502052
P-3001
1712502052
P-3142
P166196000058
P-3142
P166195000080
P-1450
F3HG4B8000648
P-1450
F3HG4A7004304
P-1450
F3HG4B8000511
P-1389
P-1118
152502087
P-1118
152502087
P-1118
152502087
P-1118
152502087
P-1118
152502087
P-4614
101502002
P-1115
152502052
P-1115
152502052
P-1115
152502052
P-1115
152502052
P-1115
152502052
P-3124
PW0B1B5000172
P-3124
PW0B1B8000636
P-2772
P-2772
P-2772
P-2772
P-3950
1750502077
P-3950
1750502077
P-4664
154500003
P-4664
154500003
P-1438
151502008
P-2560
162500048
P-2560
1760500006
P-2732
1760500006
P-1444
1780502001
P-3126
PVO21B6001989




<colgroup><col></colgroup><tbody>
</tbody>
******** type="cosymantecnisbfw" cotype="cs" id="SILOBFWOBJECTID" style="width: 0px; height: 0px; display: block;"></object>
 
Upvote 0
First make sure you have no blanks in column A and check that there are no merged cells in the data that you put in column A.

I found a couple cells that were merged, but after unmerging there was still the error.

Seemed if the first P-number entry had a serial number it would error. If it did not have a serial number then it seemed to work okay.

Put these codes in a standard module.

Run Sub MyScan().

Howard

Code: 
Option Explicit

Sub MyScan()
'/by Claus
Dim LRow As Long
Dim myArr As Variant
Dim arrOut() As Variant
Dim i As Long, j As Long
Dim myCt As Long

With Sheets("Sheet1")
    LRow = .Cells(.Rows.Count, 1).End(xlUp).Row

    myArr = .Range("A1:A" & LRow)
    myCt = WorksheetFunction.CountIf(.Range("A1:A" & LRow), "P" & "*")

    For i = LBound(myArr) To UBound(myArr)
        ReDim Preserve arrOut(myCt - 1, 1)
        If Left(myArr(i, 1), 1) = "P" Then
            arrOut(j, 0) = myArr(i, 1)
            j = j + 1
        Else
            arrOut(j - 1, 1) = myArr(i, 1)
        End If
    Next

    .Range("A1:B" & LRow).ClearContents
    .Range("A1").Resize(UBound(arrOut) + 1, 2) = arrOut
End With
ReScan
End Sub


Sub ReScan()
'/ by Claus
Dim LRow1 As Long, LRow2 As Long
Dim myArr As Variant

'/Modify the sheet name
With Sheets("Sheet1")
    LRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
    myArr = .Range("A1:B" & LRow1)

    .Range("C1").Resize(LRow1, 2) = myArr
    .Range("C1:D" & LRow1 + 1).RemoveDuplicates _
        Columns:=Array(1, 2), Header:=xlNo
    LRow2 = .Cells(.Rows.Count, 3).End(xlUp).Row
    With .Range("E1:E" & LRow2)
        .Formula = "=SumProduct(--($A$1:$A$" & LRow1 & _
            "=C1),--($B$1:$B$" & LRow1 & "= D1))"
        .Value = .Value
    End With
End With
End Sub
 
Upvote 0
Howard,
I tried the above code and it works well except for any line items that have a serial number that starts with the letter "P".
It seems to treat the Serial as a P-*** number instead of handling it as a a serial number.
Can we change the variable for the P-**** from "P" to "P-" as no serial would start with this.
See results from Columns C, D & E after running Macro.

RAW DATA:
P-3001
139E1403289
P-3001
139E1403292
P-3001
135B1300968
P-3142
P166196000058
P-3142
P166195000080
P-3143
F3HG4B8000648

<tbody>
</tbody>


RESULT:
P-3001
139E1403289
1​
P-3001
139E1403292
1​
P-3001
135B1300968
1​
P-3142

​
2​
P166196000058
1​
P166195000080
1​
P-3143
F3HG4B8000648
1​
P-3143
F3HG4B8000511
1​

<tbody> </tbody>


Thanks again.******** type="cosymantecnisbfw" cotype="cs" id="SILOBFWOBJECTID" style="width: 0px; height: 0px; display: block;"></object>
 
Upvote 0
Try this. Note the RED text.

Find these two lines and change from this:

Rich (BB code): 
 myCt = WorksheetFunction.CountIf(.Range("A1:A" & LRow), "P" & "*")

If Left(myArr(i, 1), 1) = "P" Then

To this

Rich (BB code): 
 myCt = WorksheetFunction.CountIf(.Range("A1:A" & LRow), "P-" & "*")

If Left(myArr(i, 1), 1) = "P-" Then

Seemed to work in my small test.

Howard
 
Upvote 0
Seems to fail with "Subscript out of range" execution error after I change the "P" to "P-" in both areas.
Hit the debug and gets to this line: arrOut(j - 1, 1) = myArr(i, 1)


******** type="cosymantecnisbfw" cotype="cs" id="SILOBFWOBJECTID" style="width: 0px; height: 0px; display: block;"></object>
 
Upvote 0
Try this change.

Rich (BB code): 
 If Left(myArr(i, 1), 1) = "P-" Then

To

Rich (BB code): 
 If Left(myArr(i, 1), 2) = "P-" Then

Howard
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
Barcode scanning tool
Replies
0
Views
745
D3FCON
D
C
  • Question
Scan and conditional print
Replies
0
Views
339
Cristigal
C
C
  • Question
Stock inventory - count unique sequences from barcode
Replies
0
Views
367
ChemistryBMS
C
G
  • Question
Using Excel formula to create HTML code text referencing specific cells
Replies
0
Views
821
gvsumich
G
D
  • Question
Creating an automated inventory system using excell and a barcode scanner
Replies
0
Views
5K
Devorr
D

Forum statistics

Threads
1,214,808
Messages
6,121,686
Members
449,048
Latest member
81jamesacct

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top