Dynamic Dictionary Entries

[Deverti]

All i wanna accomplish here is to reference the Offset(, 1) of my cases "vC" to my "vI" within each area defined by "vI"

dcG(vI.Value) = vC("Gewinn").Offset(, 1).Value
apparently isnt viable, how would i go about using one of the two cases to define a dictionary entry?

With Sheets("WWData")
For Each vI In rngE
nor am i allowed to use "For Each vI In rngE" a second time it seems, not sure what to do from here ~

Sub RekapitulationDic()
Dim dcG As Object, dcV As Object
    Set dcG = CreateObject("scripting.dictionary")
    Set dcV = CreateObject("scripting.dictionary")
Dim rngE As Range
    Set rngE = Application.Range("E2", Application.Range("E" & Rows.Count).End(xlUp))

For Each vI In rngE
    If Not IsEmpty(vI.Value) Then
        For Each vC In Range(vI, vI.End(xlDown)).Offset(, -4)
            Select Case vC.Value
                Case "Gewinn", "Verlust"
              
                    With Sheets("WWData")
                        For Each vI In rngE
                            dcG(vI.Value) = vC("Gewinn").Offset(, 1).Value
                            dcV(vI.Value) = vC("Verlust").Offset(, 1).Value
                        Next vI
                    End With
                    With Sheets("Rekapitulation")
                        For Each vI In .Range("A", .Range("A" & Rows.Count).End(xlUp))
                            If dcG.exists(vI.Value) Then vI.Offset(, 2).Value = dcG(vI.Value)
                            If dcV.exists(vI.Value) Then vI.Offset(, 2).Value = dcV(vI.Value)
                        Next vI
                    End With
                  
            End Select
        Next vC
    End If
Next vI

 

[Anthony47]

Hummm.... I got quite confused by your usage of For Each/Next and With /End With

May I suggest that you explain how your data are organized and what you wish to calculate (we already saw haw you tried to calculate it)? If you can share a sample workbook that will definitively help as it can be used to test what we could propose you.

Bye

 

[Deverti]

yea im not sure how chaotic my approach actually is. certainly open for any improvements, heh

im basically just trying to copy the values next to "Profit" and "Loss" onto another sheet with the property number as reference
https://app.box.com/s/dpkp6aljtkl0yqgtv1gcby2o7orb6e9i

 

[Anthony47]

You know your data better than me, so I am sure what you wrote is clear to you; but it's not quite as clear to me. So I made some guess, and this is what I suggest:

Sub Recap()
Dim PropArr(), wwSh As Worksheet, cProp As String
Dim LastA As Long, I As Long, PropCnt As Long, iProp As Long
Dim RecapLoc As Range
'
Set wwSh = Sheets("WWData")                     '<<< The Data sheet
Set RecapLoc = Sheets("Overview").Range("F4")   '<<< The Recap position
'
LastA = wwSh.Cells(Rows.Count, "A").End(xlUp).Row
PropCnt = Application.WorksheetFunction.CountA(wwSh.Range("E1").Resize(LastA, 1))
If PropCnt > 0 Then
ReDim PropArr(1 To PropCnt, 1 To 3)
    For I = 1 To LastA
        If wwSh.Cells(I, "E").Value <> "" Then
            iProp = iProp + 1
            cProp = wwSh.Cells(I, "E").Value
            PropArr(iProp, 1) = cProp
        End If
        If UCase(wwSh.Cells(I, "A").Value) = "PROFIT" Then
            If iProp > 0 Then PropArr(iProp, 2) = wwSh.Cells(I, "B").Value
        ElseIf UCase(wwSh.Cells(I, "A").Value) = "LOSS" Then
            If iProp > 0 Then PropArr(iProp, 3) = wwSh.Cells(I, "B").Value
        End If
    Next I
    RecapLoc.Resize(1000, 3).ClearContents
    RecapLoc.Resize(1, 3) = Array("Prop Name", "Profit", "Loss")
    RecapLoc.Offset(1, 0).Resize(PropCnt, 3) = PropArr
End If
End Sub

The lines marked <<< have to be compiled according the comment in the line.

This macro will simply scan the data worksheet, collect from column E the Prop Name, and associate to each of them the "next" Profit and Loss values

A table will be written at the choosen position with these values: Prop Name, Profit, Loss
Currently the output table position is set to Sheets("Overview").Range("F4")
And beware: the recap table is cleared before writing the new calculated results

Probably this is not what you were looking for, but then you need to give some more explanation

Bye

 

[Deverti]

Not what i expected and new territory for me but it helped me out enormously.

Thanks so much for this!