Excel Barcode Scanner Column Data to Row - vba

Question

I am using a barcode scanner to do inventory with large quantities and I want to enter the data into excel. I can change the way that the scanner behaves after each scan to do things like tab, return, etc. but my big problem is that in order to efficiently provide the quantity I have to scan the item code (7 digits) and then scan the quantities from 0 to 9 in succession. Such that 548 is really 5, 4, 8 and when using excel it puts each number into a new cell. What I would like to do, but don't have the VBA chops to do it is to have excel check to see if the length is 7 digits or one digit. For each one digit number it should move the number to the next cell in the same row as the previous 7 digit number such that each successive one digit number is combined as if excel were concatenating the cells. Then it should delete the single digits in the original column and have the next row start with the 7 digit barcode number.
I hope this makes sense.
Example:
7777777
3
4
5
7777778
4
5
6
7777779
7
8
9
Should become:
| 7777777 | 345 |
| 7777778 | 456 |
| 7777779 | 789 |
Thanks!!

Answer 1

I set up my worksheet like this:
then ran the below code
Sub Digits()
Application.ScreenUpdating = False
Dim i&, r As Range, j&
With Columns("B:B")
.ClearContents
.NumberFormat = "#"
End With
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Set r = Cells(i, 1)
If Len(r) = 7 Then
j = 1
Do Until ((Len(r.Offset(j, 0).Text) = 7) Or (IsEmpty(r.Offset(j, 0))))
Cells(i, 2) = CStr(Cells(i, 2).Value) & CStr(r.Offset(j, 0))
j = j + 1
Loop
End If
Set r = Nothing
Next
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Len(Cells(i, 1)) < 7 Then Rows(i & ":" & i).Delete
Next i
Columns.AutoFit
Application.ScreenUpdating = True
End Sub
and the results Ive got:

Answer 2

This is what I did with what you started but I think your newer solution will work better. Thank you so much mehow!
Sub Digits()
Application.ScreenUpdating = False
Dim i, arr, r As Range
Dim a, b, c, d, e
Dim y
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Set r = Cells(i, 1)
Set a = Cells(i + 1, 1)
Set b = Cells(i + 2, 1)
Set c = Cells(i + 3, 1)
Set d = Cells(i + 4, 1)
Set e = Cells(i + 5, 1)
If Len(a) = 7 Then
y = 0
ElseIf Len(b) = 7 Then
y = 1
ElseIf Len(c) = 7 Then
y = 2
ElseIf Len(d) = 7 Then
y = 3
ElseIf Len(e) = 7 Then
y = 4
Else:
y = 0
End If
If Len(r) = 7 Then
arr = Range("A" & i & ":A" & i + y).Value
Range("B" & i & ":F" & i) = WorksheetFunction.Transpose(arr)
End If
Next
Cells.Replace "#N/A", "", xlWhole
Application.ScreenUpdating = True
End Sub