VBA excel Loop through 2 arrays together

Question

I am filling two arrays with values one for inclusion and the other for exclusion. All working to this point. The next part should take the values from each array and replace unwanted values with a blank space. This also works but only for the first value. I know i need a loop here but can't get my head around it. Any pointers would be helpful. If there is a better way, I'm all ears.

Sub Service_Symbols()

Application.ScreenUpdating = False
Dim StringArray() As String

Dim i As Long
Dim ii As Long
Dim iii As Long

For i = Sheet2.Cells(Rows.Count, 11).End(xlUp).Row To 2 Step -1
    'Seperate multiple values in cells
    If InStr(Cells(i, 11).Value, ",") <> 0 Then
        StringArray() = Split(Cells(i, 11).Value, ",")
        'Place selected values into array for inclusion
        For ii = LBound(StringArray) To UBound(StringArray)
            If IsInArray(StringArray(), "1") Or IsInArray(StringArray, "4") Or IsInArray(StringArray, "5") Or IsInArray(StringArray, "6") Or IsInArray(StringArray, "7") Or IsInArray(StringArray, "8") Then
                result = Join(StringArray(), " ")
            End If
        Next ii
        'Place selected values into array for removal
        For iii = LBound(StringArray) To UBound(StringArray)
            ResultDel = StringArray(iii)
            If InStr(ResultDel, "2") <> 0 Or InStr(ResultDel, "3") <> 0 Or InStr(ResultDel, "9") <> 0 Or InStr(ResultDel, "11") <> 0 Then
            del = ResultDel
            Debug.Print i; ResultDel
            End If
        Next iii

        'This section not working. Needs to be looped

        'Remove unwanted values
        ServiceSym = Trim(Replace(Replace(Replace(result, del, ""), del, ""), "  ", " "))
        ServiceSym = Replace(ServiceSym, " ", ",")
        'Sheet1.Range("G" & i).Value = ServiceSym
        Debug.Print i; ServiceSym
        'Debug.Print result
        'Debug.Print i; del

        'End of this section not working. Needs to be looped

    'transfer selected single values in cells
    ElseIf Sheet2.Range("K" & i).Value = "1" Or Sheet2.Range("K" & i).Value = "4" Or Sheet2.Range("K" & i).Value = "5" Or Sheet2.Range("K" & i).Value = "6" Or Sheet2.Range("K" & i).Value = "7" Or Sheet2.Range("K" & i).Value = "8" Then
    result2 = Sheet2.Range("K" & i).Value
    'Sheet1.Range("G" & i).Value = result2
    Debug.Print i; result2
    End If
Next i

Application.ScreenUpdating = True

'Call More_Services_Symbols 'Run the more services sub

End Sub

What's in IsInArray ?

Tim Williams
– Tim Williams

2017-05-17 15:58:49 +00:00
Commented May 17, 2017 at 15:58 — Tim Williams
– Tim Williams, Commented May 17, 2017 at 15:58
Is inarray a function?

John Muggins
– John Muggins

2017-05-17 17:21:46 +00:00
Commented May 17, 2017 at 17:21 — John Muggins
– John Muggins, Commented May 17, 2017 at 17:21

J. Garth · Accepted Answer · 2017-05-17 18:26:51Z

1

Adding this sub and replacing the section that is not working with a call to the sub should work.

Sub RemoveUnwantedValues(ByRef result As String, del)

    Dim i           As Integer
    Dim arrResult() As String


    arrResult = Split(result, " ")

    For i = LBound(arrResult) To UBound(arrResult)
        arrResult(i) = Trim(Replace(Replace(Replace(arrResult(i), del, ""), del, ""), "  ", " "))
        arrResult(i) = Replace(arrResult(i), " ", ",")
    Next i

End Sub

You can call it this way: RemoveUnwantedValues result, del

edited May 17, 2017 at 18:26

answered May 17, 2017 at 17:29

J. Garth

8037 silver badges10 bronze badges

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

2 Comments

John Muggins Over a year ago

,that's where I was getting lost in his logic. "Result" is not an array. It's just a variant variable. OP needs to turn it into an array and your code should work.

J. Garth Over a year ago

Thanks Johh. I updated the code based on your comment. And thanks to David for adding the del argument.

Joe Black · Accepted Answer · 2017-05-18 12:47:16Z

Thanks for your help. It turns out i was over complicating things. All i ended up needing to do was remove the join on result remove loop iii and place If instr, del & ServiceSym inside of loop ii.

Sub Service_Symbols()

Application.ScreenUpdating = False
Dim StringArray() As String

Dim i As Long

For i = Sheet2.Cells(Rows.Count, 11).End(xlUp).Row To 2 Step -1
'Seperate multiple values in cells
If InStr(Cells(i, 11).Value, ",") <> 0 Then
    StringArray() = Split(Cells(i, 11).Value, ",")
    'Place selected values into array for inclusion
    For ii = LBound(StringArray) To UBound(StringArray)
        If IsInArray(StringArray(), "1") Or IsInArray(StringArray, "4") Or IsInArray(StringArray, "5") Or IsInArray(StringArray, "6") Or IsInArray(StringArray, "7") Or IsInArray(StringArray, "8") Then
            result = StringArray(ii)
            'Debug.Print i; result
        End If
        If InStr(result, "2") <> 0 Or InStr(result, "3") <> 0 Or InStr(result, "9") <> 0 Or InStr(result, "11") <> 0 Then
            del = result
            'Debug.Print i; "del-"; del
        End If
    ServiceSym = Replace(result, del, "")
    'Sheet1.Range("G" & i).Value = ServiceSym
    Debug.Print i; ServiceSym

    Next ii

'transfer selected single values in cells
ElseIf Sheet2.Range("K" & i).Value = "1" Or Sheet2.Range("K" & i).Value = "4" Or Sheet2.Range("K" & i).Value = "5" Or Sheet2.Range("K" & i).Value = "6" Or Sheet2.Range("K" & i).Value = "7" Or Sheet2.Range("K" & i).Value = "8" Then
result2 = Sheet2.Range("K" & i).Value
'Sheet1.Range("G" & i).Value = result2
Debug.Print i; result2
End If
Next i

Application.ScreenUpdating = True

'Call More_Services_Symbols 'Run the more services sub

End Sub

Collectives™ on Stack Overflow

VBA excel Loop through 2 arrays together

2 Answers 2

2 Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

2 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related