iDeviceGuy
iDeviceGuy

Reputation: 993

Why is my collection blank?

This is a VBA script. I'm not sure why my collection isn't populating the "By Market" sheet.

Sub ArrayPractice()

Dim r As Integer
Dim i As Integer
Dim a As Integer
Dim numberOfRows As Integer
Dim names() As String
Dim resourceCollect As Collection

Dim Emp As Resource
Dim Count As Long

Set resourceCollect = New Collection

a = Worksheets("DATA").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
r = 2 'row that i start looping from
i = 0

For Each Emp In resourceCollect

For Count = 0 To a
Emp.Name = Cells(r, 1).Value
Emp.Title = Cells(r, 2).Value
Emp.City = Cells(r, 3).Value
resourceCollect.Add Emp
r = r + 1
Next Count
Next Emp

''''print the array!''''

Sheets.Add.Name = "By Market"
Sheets.Add.Name = "By Resource Level"
Sheets.Add.Name = "By Resource Manager"



Sheets("By Market").Select
Range("C36").Select
r = 36
For Each Emp In resourceCollect
If Emp.City = "Dallas" Then
Cells(r, 3).Select
Debug.Print Emp.Name
r = r - 1
End If
Next Emp

Range("D36:D36").Select
r = 36
For Each Emp In resourceCollect
If Emp.City = "Denver" Then
Cells(r, 4).Select
Debug.Print Emp.Name
r = r - 1
End If
Next Emp

Range("E36:E36").Select
r = 36
For Each Emp In resourceCollect
If Emp.City = "Houston" Then
Cells(r, 5).Select
Debug.Print Emp.Name
r = r - 1
End If
Next Emp

Range("F36:F36").Select
r = 36
For Each Emp In resourceCollect
If Emp.City = "Kansas City (Missouri)" Then
Cells(r, 6).Select
Debug.Print Emp.Name
r = r - 1
End If
Next Emp

End Sub

UPDATE

Per Joseph's answer, here's what I've tried. I don't have it working just yet.

Here's a few different Subs I've been messing with. They're all trying to accomplish the same problem.

Sub stackResources()

Dim c As New Collection

Dim r1 As Excel.Range 'an object
Dim r2 As Excel.Range
Dim r3 As Excel.Range


Set r1 = Range("A1")
Set r2 = Range("B1")
Set r3 = Range("C1")

c.Add r1
c.Add r2
c.Add r3

Sheets("By Market").Select
Range("A1").Select

Dim i As Long
For i = 1 To c.Count
    Debug.Print c.Item(i)
    Next


End Sub

Sub collectionTest()
Dim c As New Collection

Dim emp As Resource


Sheets("DATA").Select

Range("A1").Select

Do Until Selection.Value = ""
    emp.name = Selection.Value
        ActiveCell.Offset(0, 1).Select
    emp.Title = Selection.Value
        ActiveCell.Offset(0, 1).Select
    emp.city = Selection.Value
        c.Add emp

    Loop


Sheets("By Market").Select
Range("A1").Select

Dim i As Long
For i = 1 To c.Count
    Debug.Print c.Item(i)
    Next




End Sub

Sub printACollection()

Dim c As New Collection

Dim s1 As String
Dim s2 As String
Dim s3 As String

Sheets("DATA").Select

Dim r As Long


r = 1
For Each cell In Range("A1")
    s1 = cell.Value
    c.Add s1
    ActiveCell.Offset(0, 1).Select
    s2 = cell.Value
    c.Add s2
    ActiveCell.Offset(0, 1).Select
    s3 = cell.Value
    c.Add s3
    Next


    Sheets("By Market").Select

      Dim i As Long

    For i = 1 To c.Count
        Debug.Print c.Item(i)
    Next



End Sub

Upvotes: 0

Views: 201

Answers (2)

Joseph
Joseph

Reputation: 5160

Here is another answer based on your comments. I think this is what you're looking for. If not, please be more descriptive and modify your question.

You have a class module called Employee with the code:

Option Explicit

Public Name As String
Public City As String
Public Title As String

Then, in a regular module, you can have something like below. Pay close attention to the example and modify it for your needs. I left the Sort code out so you can give it a shot yourself. Also, notice how I split the work up into separate functions/subs. This keeps your code clean and easier to follow. Hope this helps.

Option Explicit

Public Sub main()
    Application.ScreenUpdating = False

    Dim c As Collection
    Dim newWs As Excel.Worksheet
    Dim rData As Excel.Range

    Set rData = ThisWorkbook.Sheets("Sheet1").Range("A2:C3")

    Set c = getData(rData)
    Set newWs = ThisWorkbook.Worksheets.Add

    newWs.Name = "New report"

    Call putCollectionInWorksheet(newWs, c)

    Call sortData(newWs)

    Application.ScreenUpdating = True
End Sub

Private Function getData(ByRef rng As Excel.Range) As Collection
    ' create new collection of data
    Dim c As New Collection
    Dim i As Long
    Dim e As Employee
    For i = 1 To rng.Rows.Count
        Set e = New Employee

        e.Name = rng.Cells(i, 1) ' name column
        e.Title = rng.Cells(i, 2) ' title column
        e.City = rng.Cells(i, 3) ' city column

        c.Add e
    Next i

    Set getData = c
End Function

Private Sub putCollectionInWorksheet(ByRef ws As Excel.Worksheet, ByRef cData As Collection)
    Dim i As Long, j As Long
    Dim emp As Employee

    ' create header info
    ws.Range("A1:C1") = Array("Name", "Title", "City")
    i = 2 ' current row

    For Each emp In cData
        ws.Cells(i, 1).Value = emp.Name
        ws.Cells(i, 2).Value = emp.Title
        ws.Cells(i, 3).Value = emp.City

        i = i + 1
    Next emp
End Sub

Private Sub sortData(ByRef ws As Excel.Worksheet)
    ' code here
End Sub

Upvotes: 1

Joseph
Joseph

Reputation: 5160

What's happening is that resourceCollect has nothing in it, so in effect you aren't looping through anything. You have to add items to the collection in order to loop through it.

Here's a basic tutorial that might help:

http://www.wiseowl.co.uk/blog/s239/collections.htm

EDIT: To answer your comment:

Public Sub test()
    Dim c As New Collection

    Dim s1 As String
    Dim s2 As String
    Dim s3 As String

    s1 = "hello"
    s2 = ","
    s3 = "world"

    c.Add s1
    c.Add s2
    c.Add s3

    Dim s As String

    For Each s In c
        Debug.Print s
    Next
End Sub

This will fail because you can't loop through using the String data type...because it's just that, a data type and not an object. In this case, you have to loop through the indexes (indices?):

    Dim i As Long

    For i = 1 To c.Count
        Debug.Print c.Item(i)
    Next

However, if you use objects that are known to VBA like, say, a Range:

Public Sub test2()
    Dim c As New Collection

    Dim r1 As Excel.Range ' an object
    Dim r2 As Excel.Range

    Set r1 = Range("A1")
    Set r2 = Range("A3")

    c.Add r1
    c.Add r2

    Dim r As Excel.Range
    For Each r In c
        Debug.Print r.Address
    Next r
End Sub

This will work just fine.

If you are using custom classes, you can loop through a collection using the object like we did here with a Range object. The link I reference explains about the issues that can have and the solution of creating your own Collection object.

Upvotes: 2

Related Questions