Stock inventory cout with serial numbers sorting query

[smeeagain1]

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>

 

[L. Howard]

How about posting an small example of the "real" downloaded data that is in column A an then an example, hand done by you, to show what it should look like after a proper solution.

How much data are we talking about, just for info sake.

Regards,
Howard

 

[smeeagain1]

I should have included it earlier. Sorry.

The Scan would look like this:
Column A Column B
P-4352
P-3534
P-4568
ABCDE123
P-3333
P-5506
CDEFG234

I wold like the end result to look like:

Column A ColumnB
P-4352
P-3534
P-4568 ABCDE123
P-3333
P-5506 CDEFG234



I have approx 2000 lines to process.

 

[L. Howard]

Try this on a example worksheet, it is a bit slow, 4 to 5 seconds on 2000 rows.

Howard

Option Explicit

Sub ScanScam()

Dim lr As Long
Dim c As Range
Dim Rscan As Range

Application.ScreenUpdating = False

lr = Cells(Rows.Count, 1).End(xlUp).row
Set Rscan = Range("A2:A" & lr)

     For Each c In Rscan
       If Left(c, 1) <> "P" Then
         c.Cut c.Offset(-1, 1)
       End If
     Next

 Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 Application.ScreenUpdating = True
End Sub

 

[L. Howard]

I asked around some and got a faster version. The array is much faster than the loop.

Howard

Option Explicit

Sub MyScan2()
Dim LRow As Long
Dim myArr As Variant
Dim i As Long

LRow = Cells(Rows.Count, 1).End(xlUp).row
myArr = Range("A2:B" & LRow)
For i = LBound(myArr) To UBound(myArr)
    If Left(myArr(i, 1), 1) <> "P" Then
        myArr(i - 1, 2) = myArr(i, 1)
        myArr(i, 1) = ""
    End If
Next
Range("A2:B" & LRow).ClearContents
Range("A2:B" & UBound(myArr)) = myArr
Range("A2:A" & LRow).SpecialCells(xlCellTypeBlanks) _
    .EntireRow.Delete
End Sub

 

[L. Howard]

A quick update for probably as fast as it will get.
I tested it on 10,000 rows and it was a blink to finish.
Thanks to Claus of MS Public Group

Note the Option 1

Howard

Option Explicit
Option Base 1

Sub MyScan5()

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

End Sub

 

[smeeagain1]

This is brilliant guys. Thanks for the help. To take it one step further, can we get it to the amount of same scanned P-**** numbers. IE:

Column A Column B Column C
P-2345
P-2345
P-3456
ABC123
P-6789
P-0987
CDEFG

To:
Column A Column B Column C
P-2345 2
P-3456 ABC123 1
P-6789 1
P-0987 CDEFG 1


This would be awesome. Thanks in advance for any help.

<img id="ums_img_tooltip" class="UMSRatingIcon">

 

[L. Howard]

I don't understand what you are applying the count to.

Maybe you could explain it in another way.

"Same scanned P-****" has some implication of more than one or identical P-****'s but I'm not clear on what to count.

Against the entire column of 2000 rows, seems quite daunting.

Howard

 

[smeeagain1]

Hi.
After moving the serial numbers from the count using the VB above (which works great. Thanks.), I would like to count the P-**** records and display one P-**** record with the count number in column C.

So if in column A there is six entries in cells for P-1234, then consolidate all of them into one record and put the count value into column C. Entries that have a serial number after them once the above VB script is run can stand alone as individual line entries.

i know I am asking a lot, however, would be great if it can be done.

 

[mirabeau]

This is brilliant guys. Thanks for the help. To take it one step further, can we get it to the amount of same scanned P-**** numbers. IE:

Column A Column B Column C
P-2345
P-2345
P-3456
ABC123
P-6789
P-0987
CDEFG

To:
Column A Column B Column C
P-2345 2
P-3456 ABC123 1
P-6789 1
P-0987 CDEFG 1


This would be awesome. Thanks in advance for any help.

<img id="ums_img_tooltip" class="UMSRatingIcon">

Sub reorganize()

Dim a, c&, d&, i&, lr&
lr = Cells(Rows.Count, 1).End(xlUp).Row + 1
With Cells(2, 1).Resize(lr, 3)
    a = .Value
For i = 1 To lr
    If InStr(a(i, 1), "P") = 1 Then
        If a(i, 1) = a(i + 1, 1) Then
            c = c + 1
        Else
            d = d + 1
            a(d, 1) = a(i, 1)
            a(d, 2) = c + 1
            c = 0
        End If
    Else
        a(d, 2) = a(i, 1)
        a(d, 3) = 1
    End If
Next i
    .ClearContents
    .Resize(d, 3) = a
End With

End sub