Sub Boxes_and_stuff()
Dim j As Byte
Dim ThisPage As Worksheet, TargetPage As Worksheet
Dim NewBook As Workbook
Set ThisPage = ThisWorkbook.ActiveSheet
Set NewBook = Workbooks.Add ' or you can address an existing file with workbooks.open(filename)
Set TargetPage = NewBook.Worksheets(1) ' you can also decide the sheet where you want to write your values (here by default is the first excel's "tab")
j = 1 ' cells' scanner
Do Until IsEmpty(ThisPage.Cells(j, 1))
If ThisPage.Cells(j, 1).Text = "Box" Then
' if "Box" is found scan cell below to find bags or numbers
If ThisPage.Cells(j + 1, 1).Text = "Bag" Then TargetPage.Cells(1 + j, 1) = "Box 0 1" ' if only a bag is found
If ThisPage.Cells(j + 1, 1).Text = "Box" Then TargetPage.Cells(1 + j, 1) = "Box 0 0" ' if nothing is inside a box and another box comes next (I'm assuming that "0" items will never show)
If IsNumeric(ThisPage.Cells(j + 1, 1)) Then ' if a number shows...
If (ThisPage.Cells(j + 2, 1)).text = "Bag" then '... the next can be bag
TargetPage.Cells(1 + j, 1) = "Box " & ThisPage.Cells(j + 1, 1) & " 1"
Else '...or not
TargetPage.Cells(1 + j, 1) = "Box " & ThisPage.Cells(j + 1, 1) & " 0"
End If
End If
End If
j = j + 1
Loop
End Sub