CODEWITHSUNDEEP
vbaexceldictionary
Koda
Koda

Reputation: 177

Add separate columns into a dictionary

I am trying to add data from a split range (X5:X?,AX5:AX?) into a VBA dictionary. ? Is determined as the last row of data within the sheet. I am new to VBA and trying to force my way through this.

Public Sub Test
'Creates a dictionary object
 Dim orderstatus As Object, path As String
 Set orderstatus = CreateObject("Scripting.Dictionary")
 Dim order, status 'key and object names
 order = "Order #": status = "Order Status"
 path = ThisWorkbook.path

'Central District--A Head Water Order Summary
 Dim app As New Excel.Application, book As Excel.Workbook
 app.Visible = False
 Set book = app.Workbooks.Add(path & "\CENTRAL DIST\A HEAD - WATER ORDER SUMMARY.xls")


'A Head #1
 Dim A1Head As Integer, last As Integer, l as Integer
 l = 4
 book.Worksheets("A HEAD #1").Activate
 last = Range("X" & Rows.Count).End(xlUp).Row

 Set lastCol = Range("X5:X" & last, "AX5:AX" & last)
 For Each l In lastCol.Cells
    orderstatus.Add lastCol.Value
 Next
End Sub

Any help is greatly appreciated!

Upvotes: 0

Views: 67

Answers (3)

tigeravatar
tigeravatar

Reputation: 26640

I think something like this is what you're looking for:

Sub tgr()

    Dim OrderStatus As Object
    Dim i As Long
    Dim Key As Variant

    Set OrderStatus = CreateObject("Scripting.Dictionary")

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    With Workbooks.Open(ThisWorkbook.Path & "\CENTRAL DIST\A HEAD - WATER ORDER SUMMARY.xls").Sheets("A HEAD #1")
        For i = 5 To .Cells(.Rows.Count, "X").End(xlUp).Row
            If Not OrderStatus.Exists(.Cells(i, "X").Value) Then OrderStatus(.Cells(i, "X").Value) = .Cells(i, "AX").Value
        Next i
        .Parent.Close False
    End With

    'Print dictionary to text file
    Close #1
    Open ThisWorkbook.Path & "\OrderStatus Output.txt" For Output As #1
    Print #1, "Key" & vbTab & "Value"
    For Each Key In OrderStatus.Keys
        Print #1, Key & vbTab & OrderStatus(Key)
    Next Key
    Close #1

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Upvotes: 1

DisplayName
DisplayName

Reputation: 13386

you're messing up with Range object and Row index

and you'd better abandon the Activate/ActiveXXX pattern and use fully qualified range references

give this code a try

Option Explicit

Public Sub Test()
    'Creates a dictionary object
    Dim orderstatus As Object
    Set orderstatus = CreateObject("Scripting.Dictionary")

    'Central District--A Head Water Order Summary
    Dim app As New Excel.Application, book As Excel.Workbook
    app.Visible = False
    Set book = app.Workbooks.Add(ThisWorkbook.path & "\CENTRAL DIST\A HEAD - WATER ORDER SUMMARY.xls")

    'A Head #1
    Dim dataRng As Range, r As Range
    Dim last As Integer
    With book.Worksheets("A HEAD #1")
        For Each r In .Range("X5", .Cells(.Rows.Count, "X").End(xlUp))
           orderstatus(r.value) = r.Offset(, 26).value
        Next
    End With
End Sub

Moreover if you're running this macro from within an Excel session already, you don't need to get another instance of it nor explicitly reference it:

Option Explicit

Public Sub Test()
    'Creates a dictionary object
    Dim orderstatus As Object
    Set orderstatus = CreateObject("Scripting.Dictionary")

    'Central District--A Head Water Order Summary
    Dim book As Workbook
    Set book = Workbooks.Add(ThisWorkbook.path & "\CENTRAL DIST\A HEAD - WATER ORDER SUMMARY.xls")

    'A Head #1
    Dim dataRng As Range, r As Range
    Dim last As Integer
    With book.Worksheets("A HEAD #1")
        For Each r In .Range("X5", .Cells(.Rows.Count, "X").End(xlUp))
           orderstatus(r.value) = r.Offset(, 26).value
        Next
    End With
End Sub

Upvotes: 0

braX
braX

Reputation: 11755

Change this

orderstatus.Add lastCol.Value

to this

orderstatus.Add l.Value, 1

This assumes you will have no duplicates because you aren't checking for that and will get an error if you do have duplicates.

Upvotes: 0

Related Questions