CODEWITHSUNDEEP
arraysvbaelement
D.Vas
D.Vas

Reputation: 47

VBA: replacing array elements

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

Upvotes: 0

Views: 147

Answers (2)

D.Vas
D.Vas

Reputation: 47

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

Upvotes: 0

John Coleman
John Coleman

Reputation: 51998

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

Upvotes: 1

Related Questions