简体   繁体   中英

VBA excel Loop through 2 arrays together

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

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

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM