VBA: replacing array elements - arrays

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.)?

Answer 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

Answer 2

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 :)