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.