Add and Remove Items from Collection

The below workbook and code shows you how to add and remove items from a VBA collection. This is basically the same as the end of the video where I just repeatedly copy and paste a contiguous dataset except it has more optionality for slightly disorganized or randomly organized data.

Sub AddItemsToCollection()

    Dim dirCollection As Collection
    Set dirCollection = New Collection
 
    
erow = Range("A" & Rows.Count).End(xlUp).Row
    
Dim xx As Double
xx = 1

Dim stringholder As String

Do Until xx > erow
stringholder = Range("A" & xx).Value

If Range("B" & xx).Value > 0 Then
dirCollection.Add (stringholder)
End If

xx = xx + 1
Loop

xx = 1
Sheets(2).Select

Do Until xx > dirCollection.Count
Range("A" & xx).Value = dirCollection(xx)
xx = xx + 1
Loop

xx = 1
Do Until xx > dirCollection.Count
Range("B" & xx).Value = dirCollection(xx)
xx = xx + 1
Loop

xx = 1

Do Until xx > dirCollection.Count
Range("C" & xx).Value = dirCollection(xx)
xx = xx + 1
Loop

xx = 1

Do Until xx > dirCollection.Count
Range("D" & xx).Value = dirCollection(xx)
xx = xx + 1
Loop

erow = Range("A" & Rows.Count).End(xlUp).Row

Range("A1:A" & erow).Select
Selection.Copy

erow = erow + 2

Range("A" & erow).Select
ActiveSheet.Paste

erow2 = Range("A" & Rows.Count).End(xlUp).Row

Range("A" & erow2).Select
ActiveSheet.Paste


erow3 = Range("A" & Rows.Count).End(xlUp).Row

Range("A" & erow3 & ":" & "B" & erow3).Select
ActiveSheet.Paste

xx = 1
xxx = 1
Dim yy As Double
yy = dirCollection.Count

Do Until xxx > yy
dirCollection.Remove xx

xxx = xxx + 1

Loop

End Sub