'Code commented to explain
Sub Remove_Non_C()
Application.ScreenUpdating = False
Dim lrow, j, k, l As Long
Dim strType, strTmp, newType, newTmp As String
Dim arrType, arrTmp As Variant
Dim iType As Variant
'get last row
lrow = Range("F50000").End(xlUp).Row
'loop Types
For Each iType In Range("F2:F" & lrow)
'build array
strType = iType.Text
arrType = Split(strType, Chr(10))
'Loop array
newType = ""
For j = 0 To UBound(arrType)
'check for non C
If Trim(arrType(j)) <> "C" Then
'remove
arrType(j) = ""
Else
'build new string
newType = newType & arrType(j) & Chr(10)
End If
Next j
'Loop Adjacent cells
For k = -2 To 6
'not itself
If k <> 0 Then
'build array
strTmp = iType.Offset(0, k).Text
arrTmp = Split(strTmp, Chr(10))
'loop array
newTmp = ""
For l = 0 To UBound(arrTmp)
'check for non C place in Type
If l <= UBound(arrType) And arrType(l) = "" Then
'remove
arrTmp(l) = ""
Else
'build new string
newTmp = newTmp & arrTmp(l) & Chr(10)
End If
Next l
'replace contents of cell with new string
iType.Offset(0, k).Formula = newTmp
End If
Next k
'replace Type with non C version
iType.Formula = newType
Next
Application.ScreenUpdating = False
End Sub
|
