VBA: replacing array elements

Question

Edit: based on the comments, I'm providing more details on the code.

The idea of the code is:

There are strings stored in a range B6:E6 (e.g. B6 = "Actual Sales", C6 = "SOP11 (2015)", D6 = "SOP12 (2015)", E6 = "SOP10 (2015)").

I calculate the integer by using "Mid" function if the string is not "Actual Sales".

When that's done, the calculated integers are sorted using BubbleSort in array.

Afterwards, I would like to link the sorted integers (SOP_key_B6, SOP_key_C6, SOP_key_D6, SOP_key_E6) with the original string (cell_b6, cell_c6, cell_d6, cell_e6). In other words, there's a one-to-one correspondence between SOP_key_B6 and cell_b6, etc.)

I want to do the above, because I need to input to the range L30:O30 the sorted array with strings based on the sorted integers.

I hope this makes the idea clear as it's not very complicated, but the approach itself & code makes it a bit frustrating (probably because I'm still learning the VB coding).

Here's the code:

Sub Worksheet_Delta_Update()

'Variables
Dim wb As Workbook, ws_wk_dlt As Worksheet, ws_dash As Worksheet, cell_B6 As  Variant, _
cell_C6 As Variant, cell_D6  As Variant, cell_E6 As Variant, SOP_key_B6 As Variant, _
SOP_key_C6 As Variant, SOP_key_D6 As Variant, SOP_key_E6 As Variant

'Referencing
Set wb = ThisWorkbook
Set ws_wk_dlt = wb.Worksheets("t")
Set ws_dash = wb.Worksheets("x")

'Values from pivot stored
cell_B6 = ws_wk_dlt.Range("B6").Value
cell_C6 = ws_wk_dlt.Range("C6").Value
cell_D6 = ws_wk_dlt.Range("D6").Value
cell_E6 = ws_wk_dlt.Range("E6").Value

'If len certain amount of characters then do option 1, or option 2
If cell_B6 <> "" Then
    If Len(cell_B6) = 12 And cell_B6 <> "Actual Sales" Then
            SOP_key_B6 = CInt(Mid(cell_B6, 4, 2)) + CInt(Mid(cell_B6, 8, 4))
    ElseIf Len(cell_B6) = 11 And cell_B6 <> "Actual Sales" Then
        SOP_key_B6 = CInt(Mid(cell_B6, 4, 2)) + CInt(Mid(cell_B6, 7, 4))
    End If
End If

If cell_C6 <> "" Then
    If Len(cell_C6) = 12 And cell_C6 <> "Actual Sales" Then
            SOP_key_C6 = CInt(Mid(cell_C6, 4, 2)) + CInt(Mid(cell_C6, 8, 4))
    ElseIf Len(cell_C6) = 11 And cell_C6 <> "Actual Sales" Then
        SOP_key_C6 = CInt(Mid(cell_C6, 4, 2)) + CInt(Mid(cell_C6, 7, 4))
    End If
End If

If cell_D6 <> "" Then
    If Len(cell_D6) = 12 And cell_D6 <> "Actual Sales" Then
            SOP_key_D6 = CInt(Mid(cell_D6, 4, 2)) + CInt(Mid(cell_D6, 8, 4))
    ElseIf Len(cell_D6) = 11 And cell_D6 <> "Actual Sales" Then
        SOP_key_D6 = CInt(Mid(cell_D6, 4, 2)) + CInt(Mid(cell_D6, 7, 4))
    End If
End If

If cell_E6 <> "" Then
    If Len(cell_E6) = 12 And cell_E6 <> "Actual Sales" Then
            SOP_key_E6 = CInt(Mid(cell_E6, 4, 2)) + CInt(Mid(cell_E6, 8, 4))
    ElseIf Len(cell_E6) = 11 And cell_E6 <> "Actual Sales" Then
        SOP_key_E6 = CInt(Mid(cell_E6, 4, 2)) + CInt(Mid(cell_E6, 7, 4))
    End If
End If

'Finding the Actual Sales and putting into L30
If cell_B6 = "Actual Sales" Then
    ws_dash.Range("L31").Value = cell_B6
ElseIf cell_C6 = "Actual Sales" Then
    ws_dash.Range("L31").Value = cell_C6
ElseIf cell_D6 = "Actual Sales" Then
    ws_dash.Range("L31").Value = cell_D6
ElseIf cell_E6 = "Actual Sales" Then
    ws_dash.Range("L31").Value = cell_E6
End If

'BubbleSort in Descending order
Dim ArrayToSort(0 To 4) As Variant

ArrayToSort(0) = SOP_key_B6
ArrayToSort(1) = SOP_key_C6
ArrayToSort(2) = SOP_key_D6
ArrayToSort(3) = SOP_key_E6

'Moving upwards because of -1
For j = UBound(ArrayToSort) - 1 To LBound(ArrayToSort) Step -1

  'Starting at lowest
    For i = LBound(ArrayToSort) To j
      If ArrayToSort(i) > ArrayToSort(i + 1) Then
      vTemp = ArrayToSort(i)
      ArrayToSort(i) = ArrayToSort(i + 1)
      ArrayToSort(i + 1) = vTemp
      End If
    Next i
Next j

'Put sorted array into the range
'But how to put the values linked to integers?
'E.g. SOP_key_B6 = cell_B6 
 ws_dash.Range("L30:O30").Value = ArrayToSort

 End Sub

Most probably the solution is with replacing the array elements with the correct ones (i.e. SOP_key_B6 = cell_B6, etc.)?

Please explain your code. Please show us relevant parts only. — timbmg
– timbmg, Commented Jan 19, 2016 at 22:28
You may wish to provide inputs, what outputs you expect those inputs to yield, and how the actual output differs. Refer to stackoverflow.com/help/mcve — Nathaniel Ford
– Nathaniel Ford, Commented Jan 19, 2016 at 23:30
Thanks, guys, please advise if the revised description makes more sense — D.Vas
– D.Vas, Commented Jan 20, 2016 at 9:31

John Coleman · Accepted Answer · 2016-01-22 15:14:55Z

1

Your code is bloated in places, for example:

Dim ArrayToSort(0 To 4) As Variant

ArrayToSort(0) = SOP_key_B6
ArrayToSort(1) = SOP_key_C6
ArrayToSort(2) = SOP_key_D6
ArrayToSort(3) = SOP_key_E6

can be replaced by

Dim ArrayToSort As Variant 'note lack of ()
ArrayToSort = Array(SOP_key_B6, SOP_key_C6, SOP_key_D6, SOP_key_E6)

As far as your question goes, it seems that you need to use a collection. Assuming that there is a one-to-one correspondence between the SOP-key_ values and the cell_ values (otherwise, calling them "keys" is misleading), you could do the following:

Dim C As New Collection
C.Add cell_B6, CStr(SOP_key_B6)
C.Add cell_C6, CStr(SOP_key_C6)
C.Add cell_D6, CStr(SOP_key_D6)
C.Add cell_E6, CStr(SOP_key_E6)

then, after sorting ArrayToSort, have a loop like:

For i = 0 to 3
    Range("L30").Offset(0,i).Value = C(CStr(ArrayToSort(i)))
Next i

I think this is what you are looking for -- but the code seems on the convoluted side so it might not be a bad idea to streamline it a bit.

On Edit:

You are getting duplicate keys due to the way you are constructing the keys by adding note that SOP11(2015) differs from SOP10(2016) but 11+2015 = 10 + 2016 (both equal to 2026). Instead -- juxtapose: 112015 isn't 102016.

Furthermore, it makes sense to split the key creation into its own function (so you don't repeat essentially the same code 4 times:

Function ExtractKey(s As Variant) As Long
    Dim v As Variant, n As Long
    v = Trim(s)
    If v Like "*(*)" Then
        n = Len(v)
        v = Mid(v, n - 7, 7)
        v = Replace(v, "(", "")
        ExtractKey = CLng(v)
    Else
        ExtractKey = 0
    End If
End Function

Note that the return type is Long -- Integer variables overflow too easily to be useful in VBA.

Then -- something like this should work:

Sub Worksheet_Delta_Update()
    Dim SourceRange As Range, TargetRange As Range
    Dim i As Long, j As Long, minKey As Long, minAt As Long
    Dim v As Variant
    Dim C As New Collection

    Set SourceRange = Worksheets("t").Range("B6:E6")
    Set TargetRange = Worksheets("t").Range("L30:O30")

    For i = 1 To 4
        v = SourceRange.Cells(1, i).Value
        C.Add Array(ExtractKey(v), v)
    Next i

    'transfer data
    For i = 1 To 4
        minAt = -1
        For j = 1 To C.Count
            If minAt = -1 Or C(j)(0) < minKey Then
                minKey = C(j)(0)
                minAt = j
            End If
        Next j
        TargetRange.Cells(1, i).Value = C(minAt)(1)
        C.Remove minAt
    Next i
End Sub

edited Jan 22, 2016 at 15:14

answered Jan 20, 2016 at 1:52

John Coleman

52.1k7 gold badges59 silver badges127 bronze badges

Sign up to request clarification or add additional context in comments.

12 Comments

D.Vas Over a year ago

After testing a few scenarios where only 3 or 2 variables (SOP_key_b6) are fulfilled, I'm getting an error "This key is already associated with an element in this collection"...

John Coleman Over a year ago

If the keys are the same -- are the values the same? For example, can you have SOP_key_B6 = SOP_key_C6 but cell_B6 different from cell_C6? If so -- what value(s) should go in cells L30 and M30?

D.Vas Over a year ago

No, I eliminated this by nesting another "If", so now every SOP_key is unique so as the value in cell_c6. I'm thinking about clearing the collection completely in beforehand adding new items to the collection. You think that's possible?

John Coleman Over a year ago

The line Set C = New Collection will create a new collection and assign it to C. The old collection will be garbage-collected. From the programmer's point of view this is equivalent to clearing C. Also -- you might want to look into Dictionaries which are like collections but a bit more flexible.

D.Vas Over a year ago

thanks, John, once again! Just tried your suggested method, but the error still appears :(

|

D.Vas · Accepted Answer · 2016-01-22 17:10:52Z

0

On fixed the Type mismatch error with the following modificaton:

Function ExtractKey(s As Variant) As Long
   Dim v As Variant, n As Long
   v = Trim(s) 'remove spaces leave only spaces between words
     If v Like "*(*)" Then 'if it's SOPXX (YYYY) then
       n = Len(v) 'find number of the characters
         If n = 11 Then
           v = Mid(v, n - 7, 7) 'find the number of SOP + year in bracket
         ElseIf n = 12 Then
           v = Mid(v, n - 8, 8)
         End If
        v = Replace(v, "(", "") 'replace the brackets with nothing
        v = Replace(v, " ", "")
        ExtractKey = CLng(v) 'error WAS here
      Else
        ExtractKey = 0
      End If
End Function

Edit: Added another few lines

 If n = 11 Then
         v = Right(v, 4) + Left(v, 1)
    ElseIf n = 12 Then
        v = Right(v, 4) + Left(v, 2)
    End If

The above switch year and number (e.g. SOP12 (2015) = 122015 and after switch 201512). This is because SOP12 (2014) was placed after SOP10 (2015) despite the fact it should go before as its dated year 2014. Now working like charm :)

edited Jan 22, 2016 at 17:10

answered Jan 22, 2016 at 14:38

D.Vas

471 silver badge7 bronze badges

4 Comments

D.Vas Over a year ago

@John the only thing now is that it places the values in the cells but skips blank (e.g. L30 = blank, M30 = blank, N30 = SOP2(2015), O30 = SOP11 (2015). Will try to fix myself but maybe you can advise?

John Coleman Over a year ago

Usually something like this belongs as an edit to the question (or perhaps an entirely new question) rather than as an answer. In any event, I don't think it would make a difference but you could replace the line v = SourceRange.Cells(1, i) by v = SourceRange.Cells(1, i).Value. Also -- SOP2(2015) seems to not fit the pattern of having 2 digits before the year -- it only has one.

John Coleman Over a year ago

Also -- note that Trim doesn't remove spaces inside the string -- just leading and trailing white space. I threw that in as a precaution since sometimes stray white spaces happen when users enter data

D.Vas Over a year ago

thanks for the forum rules! concenring the SOP2(2015) mistyped - it's SOP2 (2015). And yes, you were right, replacing the line didn't make the difference. I wonder why it skips blanks and the inputs the sorted values...

Collectives™ on Stack Overflow

VBA: replacing array elements

2 Answers 2

12 Comments

4 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

12 Comments

4 Comments

Your Answer

Sign up or log in

Post as a guest

Related