Using drop-down list to change multiple values in separate table cells

Sub Splt()
    Dim LR As Long, LC As Long, r As Long, c As Long, pos As Long
    Dim v As Variant

    Application.ScreenUpdating = False
    LR = Cells(Rows.Count, 1).End(xlUp).Row
    LC = Cells(1, Columns.Count).End(xlToLeft).Column
    r = 2
    Do While r <= LR
        For c = 1 To LC
            v = Cells(r, c).Value
            If InStr(v, ",") Then Exit For ' we need to split
        Next
        If c <= LC Then ' We need to split
            Rows(r).EntireRow.Insert
            LR = LR + 1
            For c = 1 To LC
                v = Cells(r + 1, c).Value
                pos = InStr(v, ",")
                If pos Then
                    Cells(r, c).Value = Left(v, pos - 1)
                    Cells(r + 1, c).Value = Trim(Mid(v, pos + 1))
                Else
                    Cells(r, c).Value = v
                End If
            Next
        End If
        r = r + 1
    Loop
    Application.ScreenUpdating = True
End Sub

=IF(C3="teamA";$H$3="win")

=IF(C3="teamA";$H$3="win") --- Applies to range: =$C$3:$C$7 (is showed above as an example)
=IF(C3="teamA";$H$3="lost") --- Applies to range: =$C$3:$C$7

=IF(C3="teamB";$H$4="win") --- Applies to range: =$C$3:$C$7
=IF(C3="teamB";$H$4="lost") --- Applies to range: =$C$3:$C$7

=IF(D3="teamC";$H$6="win") --- Applies to range: =$D$3:$D$7
=IF(D3="teamC";$H$6="lost") --- Applies to range: =$D$3:$D$7

=IF(D3="teamD";$H$7="win") --- Applies to range: =$D$3:$D$7
=IF(D3="teamD";$H$7="lost") --- Applies to range: =$D$3:$D$7

Nordic: ";"  - =IF(C3="teamA";$H$3="win")
US: ","      - =IF(C3="teamA",$H$3="win")

Option Explicit
Sub DataRange()
    Dim DataRange As Range
    Dim DataSheet As Worksheet
    Dim c As Range
    Dim DataString As String
    Dim DataDictionary As Object 'SCRIPTING.DICTIONARY
    Dim TargetColumns As Object 'SCRIPTING.DICTIONARY
    Dim TargetColumn As Long
    Dim Key As String
    Dim TargetAddress As String

    Dim xlCurrentCalculation As XlCalculation
    Dim i As Long
    TargetColumn = 2

    xlCurrentCalculation = Application.Calculation
    Application.Calculation = xlCalculationManual
'#############################################################################################
    Set DataRange = ActiveSheet.Range("A2:A21") 'EDIT THIS LINE WITH ACTUAL DATA ADDRESS
'#############################################################################################
    Set DataSheet = DataRange.Parent
    Set TargetColumns = CreateObject("SCRIPTING.DICTIONARY")
    For Each c In DataRange
        DataString = CStr(c)
        Set DataDictionary = DataStringToDataDictionary(DataString)
        For i = 0 To DataDictionary.Count - 1
            Key = DataDictionary.keys()(i)
            If Not TargetColumns.exists(Key) Then
                TargetColumns.Add Key, TargetColumn
                TargetColumn = TargetColumn + 1
            End If
            TargetAddress = TargetColumns(Key) & c.Row
            DataSheet.Cells(c.Row, TargetColumns.Item(Key)) = DataDictionary.items()(i)
        Next i
    Next c
    For i = 0 To TargetColumns.Count - 1
        DataSheet.Cells(1, TargetColumns.items()(i)) = TargetColumns.keys()(i)
    Next i

    'Uncomment the following line to delete the column of the data containing the range.
    'It will create an offset in written data though
    'DataRange.EntireColumn.Delete
    Application.Calculate
    Application.Calculation = xlCalculationAutomatic
End Sub
Function DataStringToDataDictionary(DataString As String)

    Dim DataArray() As String
    Dim DataSubArray() As String
    Dim DataDictionary As Object 'SCRIPTING.DICTIONARY
    Dim Key As String
    Dim Value As String
    Dim i As Long

    DataArray = Split(DataString, ";")
    'We ignore first element of the array, as we assume it contains the word "Data"

    Set DataDictionary = CreateObject("SCRIPTING.DICTIONARY")
    For i = 1 To UBound(DataArray)
        DataSubArray = Split(DataArray(i), "=")
        Key = DataSubArray(0)
        Value = DataSubArray(1)
        DataDictionary.Add Key, Value
    Next i

    Set DataStringToDataDictionary = DataDictionary

End Function

If the previous code does not work, you could also try the following :


Sub SplittingDataWithoutDictionary()
    Dim DataRange As Range
    Dim DataSheet As Worksheet
    Dim c As Range
    Dim DataArray() As String
    Dim DataSubArray() As String
    Dim HeadersLabels() As Variant
    Dim i As Long
    Dim FirstWriteBackColumn As Long
    Dim Index As Long
    Dim Value As String

    Dim xlCurrentCalculation As XlCalculation

    xlCurrentCalculation = Application.Calculation
    Application.Calculation = xlCalculationManual


    HeadersLabels = Array("X", "Y", "Z", "V", "G")

    Set DataRange = ActiveSheet.Range("A2:A20") 'Edit with the actual range you want to split
    Set DataSheet = DataRange.Worksheet
    FirstWriteBackColumn = 2 'Edit with the first column in which you want to write back data

    For Each c In DataRange
        DataArray = Split(CStr(c), ";")
        For i = 1 To UBound(DataArray)
            DataSubArray = Split(DataArray(i), "=")
            Index = FetchIndexInArray(HeadersLabels, DataSubArray(0))
            Value = DataSubArray(1)
            DataSheet.Cells(c.Row, FirstWriteBackColumn + Index) = Value
        Next i
    Next c
    For i = 0 To UBound(HeadersLabels)
        DataSheet.Cells(1, i + FirstWriteBackColumn) = HeadersLabels(i)
    Next i
    'Datarange.entirecolumn.delete
    Application.Calculation = xlCurrentCalculation
End Sub

Function FetchIndexInArray(StringArray() As Variant, LookFor As String) As Long
    Dim i As Long

    For i = LBound(StringArray) To UBound(StringArray)
        If StringArray(i) = LookFor Then
            FetchIndexInArray = i
            Exit Function
        End If
    Next i
End Function