# Splitting a range into to 2 ranges based on values from another range

• ### Question

• I've come up with two ways of solving my problem:

1)Split the range B2 to B26  based on whether the cell next to it is either High or Low

2) Loop through range C2 to C26 and check if either high or low. If High then go to cell on left and add that cell (say B2) to a new range ("HighRange") - PReferred choice

i know how to loop through cells but how do I check if cell value is the string "High" and crucially then go to cell to immediate left and then add that cell to new range?

Help would be appreciated

Thanks

• Edited by Tuesday, January 10, 2017 10:56 AM
Tuesday, January 10, 2017 10:56 AM

### All replies

• ```Option Explicit

Sub Test()
Dim R As Range
'Find all "High" in column C
Set R = FindAll(Range("C:C"), "High")
'Found?
If R Is Nothing Then
'No
Exit Sub
Else
'One column to the left
Set R = R.Offset(, -1)
'Name that cells
R.Name = "HighRange"
End If
End Sub

Function FindAll(ByVal Where As Range, ByVal What, _
Optional ByVal After As Variant, _
Optional ByVal LookIn As XlFindLookIn = xlValues, _
Optional ByVal LookAt As XlLookAt = xlWhole, _
Optional ByVal SearchOrder As XlSearchOrder = xlByRows, _
Optional ByVal SearchDirection As XlSearchDirection = xlNext, _
Optional ByVal MatchCase As Boolean = False, _
Optional ByVal SearchFormat As Boolean = False) As Range
'Find all occurrences of What in Where (Windows version)
Dim c As Range
'From FastUnion:
Dim Stack As New Collection
Dim Temp() As Range, Item
Dim i As Long, j As Long

If Where Is Nothing Then Exit Function
If SearchDirection = xlNext And IsMissing(After) Then
'Set After to the last cell in Where to return the first cell in Where in front if _
it match What
Set c = Where.Areas(Where.Areas.Count)
'BUG in XL2010: Cells.Count produces a RTE 6 if C is the whole sheet
'Set After = C.Cells(C.Cells.Count)
Set After = c.Cells(c.Rows.Count * CDec(c.Columns.Count))
End If

Set c = Where.Find(What, After, LookIn, LookAt, SearchOrder, _
SearchDirection, MatchCase, SearchFormat:=SearchFormat)
If c Is Nothing Then Exit Function

Do
If SearchFormat Then
'If you call this function from an UDF and _
you find only the first cell use this instead
Set c = Where.Find(What, c, LookIn, LookAt, SearchOrder, _
SearchDirection, MatchCase, SearchFormat:=SearchFormat)
Else
If SearchDirection = xlNext Then
Set c = Where.FindNext(c)
Else
Set c = Where.FindPrevious(c)
End If
End If
'Can happen if we have merged cells
If c Is Nothing Then Exit Do

'FastUnion algorithm © Andreas Killer, 2011:
'Get all cells as fragments
ReDim Temp(0 To Stack.Count - 1)
i = 0
For Each Item In Stack
Set Temp(i) = Item
i = i + 1
Next
'Combine each fragment with the next one
j = 1
Do
For i = 0 To UBound(Temp) - j Step j * 2
Set Temp(i) = Union(Temp(i), Temp(i + j))
Next
j = j * 2
Loop Until j > UBound(Temp)
'At this point we have all cells in the first fragment
Set FindAll = Temp(0)
End Function
```

Tuesday, January 10, 2017 11:12 AM