Highlight cells with inputbox

[castak]

Hi everyone!

I have a macro allowing me to color cells according to a serie I write in my inputbox. Actually, I've got a column from "name-1" in the first cell (A1) up to "name-n" in the n column (An). For example if I write in my inputbox "1-5-/-8-11-/-13-16", A1 to A5 just like A8 to A11 and A13 to A16 appear in orange. Then A6, A7 and A12 appear in blue. So if you do understand my macro, all the cells are firstly highlighted in blue and then it works with series so it splits them with "-/-". However, what I'd like to do now is to add another split condition with "-X-" with which it would highlight corresponding cells in green. For example, if I write "1-5-/-7-10-X-12-15", A1 to A5 just like A7 to A10 and A12 to A15 are highlighted in orange, A6 in blue and A11 in green. Thank you for your help cause I'm locked ...


Sub test()
Dim x$, c1 As Range, c2 As Range, nums As Variant, serie As Variant
x = InputBox("enter one/two number")
If x <> vbNullString Then
With Sheets(1).Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
.Parent.Range(.Cells(1, 1), .Cells(.Cells.Count)).Interior.Color = RGB(0, 150, 255)
serie = Split(x, ",")
For s = 0 To UBound(serie)
If Not serie(s) Like "*/*" Then serie(s) = serie(s) & "/" & serie(s)
If IsNumeric(Replace(serie(s), "/", "")) And serie(s) Like "*#/#*" Then
nums = Split(serie(s), "/")
Set c1 = .Find("name-" & nums(0), lookat:=xlWhole)
Set c2 = .Find("name-" & nums(1), lookat:=xlWhole)
critere = Not c1 Is Nothing And Not c2 Is Nothing
If critere Then .Parent.Range(c1, c2).Interior.Color = RGB(255, 200, 50) Else mess = mess & "the range containing ""name-" & nums(0) & """ & ""name-" & nums(1) & """ does not exist !!" & vbCrLf
Else
mess = " the serie " & serie(s) & " is not valid" & vbCrLf
End If
Next
If mess <> "" Then MsgBox mess
End With
Else
MsgBox "you have canceled"
End If
End Sub

[castak]

Excuse me I've just realized there is as mistake in my macro. The right code is this one :

Sub test()
Dim x$, c1 As Range, c2 As Range, nums As Variant, serie As Variant
x = InputBox("enter one/two number")
If x <> vbNullString Then
With Sheets(1).Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
.Parent.Range(.Cells(1, 1), .Cells(.Cells.Count)).Interior.Color = RGB(0, 150, 255)
serie = Split(x, "-/-")
For s = 0 To UBound(serie)
If Not serie(s) Like "*-*" Then serie(s) = serie(s) & "-" & serie(s)
If IsNumeric(Replace(serie(s), "-", "")) And serie(s) Like "*#-#*" Then
nums = Split(serie(s), "-")
Set c1 = .Find("name-" & nums(0), lookat:=xlWhole)
Set c2 = .Find("name-" & nums(1), lookat:=xlWhole)
critere = Not c1 Is Nothing And Not c2 Is Nothing
If critere Then .Parent.Range(c1, c2).Interior.Color = RGB(255, 200, 50) Else mess = mess & "the range containing ""name-" & nums(0) & """ & ""name-" & nums(1) & """ does not exist !!" & vbCrLf
Else
mess = " the serie " & serie(s) & " is not valid" & vbCrLf
End If
Next
If mess <> "" Then MsgBox mess
End With
Else
MsgBox "you have canceled"
End If
End Sub

[大灰狼1976]

i hope that would be useful for you

Sub test()
Dim x$, c1 As Range, c2 As Range, nums As Variant, serie As Variant
x = InputBox("enter one/two number")
If x <> vbNullString Then
With Sheets(1).Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
.Parent.Range(.Cells(1, 1), .Cells(.Cells.Count)).Interior.Color = RGB(0, 150, 255)
serie = Split(x, "-X-")
For s = 0 To UBound(serie) Step 2
nums = Split(serie(s), "-")
Set c1 = .Find("name-" & nums(UBound(nums)), lookat:=xlWhole)
Set c2 = .Find("name-" & Val(serie(s + 1)), lookat:=xlWhole)
critere = Not c1 Is Nothing And Not c2 Is Nothing
If critere Then .Parent.Range(c1, c2).Interior.Color = RGB(0, 255, 0) Else mess = mess & "the range containing ""name-" & nums(0) & """ & ""name-" & nums(1) & """ does not exist !!" & vbCrLf
Next s
x = Replace(x, "-X-", "-/-")
serie = Split(x, "-/-")
For s = 0 To UBound(serie)
If Not serie(s) Like "*-*" Then serie(s) = serie(s) & "-" & serie(s)
If IsNumeric(Replace(serie(s), "-", "")) And serie(s) Like "*#-#*" Then
nums = Split(serie(s), "-")
Set c1 = .Find("name-" & nums(0), lookat:=xlWhole)
Set c2 = .Find("name-" & nums(1), lookat:=xlWhole)
critere = Not c1 Is Nothing And Not c2 Is Nothing
If critere Then .Parent.Range(c1, c2).Interior.Color = RGB(255, 200, 50) Else mess = mess & "the range containing ""name-" & nums(0) & """ & ""name-" & nums(1) & """ does not exist !!" & vbCrLf
Else
mess = " the serie " & serie(s) & " is not valid" & vbCrLf
End If
Next
If mess <> "" Then MsgBox mess
End With
Else
MsgBox "you have canceled"
End If
End Sub

[大灰狼1976]

Sub test()
Dim x$, c1 As Range, c2 As Range, nums As Variant, serie As Variant
x = InputBox("enter one/two number")
If x <> vbNullString Then
With Sheets(1).Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
.Parent.Range(.Cells(1, 1), .Cells(.Cells.Count)).Interior.Color = RGB(0, 150, 255)
serie = Split(x, "-X-")
For s = 0 To UBound(serie) - 1
nums = Split(serie(s), "-")
Set c1 = .Find("name-" & nums(UBound(nums)) + 1, lookat:=xlWhole)
Set c2 = .Find("name-" & Val(serie(s + 1)) - 1, lookat:=xlWhole)
critere = Not c1 Is Nothing And Not c2 Is Nothing
If critere Then .Parent.Range(c1, c2).Interior.Color = RGB(0, 255, 0) Else mess = mess & "the range containing ""name-" & nums(0) & """ & ""name-" & nums(1) & """ does not exist !!" & vbCrLf
Next s
x = Replace(x, "-X-", "-/-")
serie = Split(x, "-/-")
For s = 0 To UBound(serie)
If Not serie(s) Like "*-*" Then serie(s) = serie(s) & "-" & serie(s)
If IsNumeric(Replace(serie(s), "-", "")) And serie(s) Like "*#-#*" Then
nums = Split(serie(s), "-")
Set c1 = .Find("name-" & nums(0), lookat:=xlWhole)
Set c2 = .Find("name-" & nums(1), lookat:=xlWhole)
critere = Not c1 Is Nothing And Not c2 Is Nothing
If critere Then .Parent.Range(c1, c2).Interior.Color = RGB(255, 200, 50) Else mess = mess & "the range containing ""name-" & nums(0) & """ & ""name-" & nums(1) & """ does not exist !!" & vbCrLf
Else
mess = " the serie " & serie(s) & " is not valid" & vbCrLf
End If
Next
If mess <> "" Then MsgBox mess
End With
Else
MsgBox "you have canceled"
End If
End Sub

[castak]

Oh perfect thank you it does works very well it's exactly what I wanted!
Just more 1 question :
After my first "If condition" (If x <> vbnullstring then), I just added : x = "1" + x so that I'm not obliged to write in my input box "1-5-etc". I can thereby only write "-4-etc"
Now, how could I do to consider that I have to write "name-4-etc" ? If I write in the code x = "name-1" + x rather than x = "1" + x it doesn't works because it takes into account twice "name-" for the first range...

[大灰狼1976]

Hi castak!
I'm a little busy in the morning(because of jet lag). I'll take a look when I have time.

[大灰狼1976]

Sorry, my English is not good,
I want to confirm the following items
1. write in inputbox = "name-4-etc"?
2. keep the result unchanged?
If my understanding is correct: x = Replace(x, "name", "1")

Sub test()
Dim x$, c1 As Range, c2 As Range, nums As Variant, serie As Variant
x = InputBox("enter one/two number")
If x <> vbNullString Then
x = Replace(x, "name", "1")
With Sheets(1).Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
.Parent.Range(.Cells(1, 1), .Cells(.Cells.Count)).Interior.Color = RGB(0, 150, 255)
serie = Split(x, "-X-")
For s = 0 To UBound(serie) - 1
nums = Split(serie(s), "-")
Set c1 = .Find("name-" & nums(UBound(nums)) + 1, lookat:=xlWhole)
Set c2 = .Find("name-" & Val(serie(s + 1)) - 1, lookat:=xlWhole)
critere = Not c1 Is Nothing And Not c2 Is Nothing
If critere Then .Parent.Range(c1, c2).Interior.Color = RGB(0, 255, 0) Else mess = mess & "the range containing ""name-" & nums(0) & """ & ""name-" & nums(1) & """ does not exist !!" & vbCrLf
Next s
x = Replace(x, "-X-", "-/-")
serie = Split(x, "-/-")
For s = 0 To UBound(serie)
If Not serie(s) Like "*-*" Then serie(s) = serie(s) & "-" & serie(s)
If IsNumeric(Replace(serie(s), "-", "")) And serie(s) Like "*#-#*" Then
nums = Split(serie(s), "-")
Set c1 = .Find("name-" & nums(0), lookat:=xlWhole)
Set c2 = .Find("name-" & nums(1), lookat:=xlWhole)
critere = Not c1 Is Nothing And Not c2 Is Nothing
If critere Then .Parent.Range(c1, c2).Interior.Color = RGB(255, 200, 50) Else mess = mess & "the range containing ""name-" & nums(0) & """ & ""name-" & nums(1) & """ does not exist !!" & vbCrLf
Else
mess = " the serie " & serie(s) & " is not valid" & vbCrLf
End If
Next
If mess <> "" Then MsgBox mess
End With
Else
MsgBox "you have canceled"
End If
End Sub

[castak]

It's exactly what I wanted to do! I though it was much more difficult than just adding a simple line! Thank you!

[castak]

I've got one more question (sorry I'm quite a beginner in VBA ^^):
As you understand, my cells contain "name-1" in A1 up to "name-n" in the An cell. What I would like to do now is to replace all
my "name-n" in all the cells by different texts (it could be anything like for example "a" in A1, "210-22" in A2, "Hello" in A3 etc...).
So if you do understand, the value of every cell would be "name-1", "name-2" etc... but the displayed text, the one that we should see
in the cells would be the ones that I just stated before as examples. I've tried to perform this thanks to conditonal formatting but by doing
so, I have to set "-1", "-2", "-3" rather than "name-1", "name-2" etc which is the form I want to keep obviously.
Just to explain quicly how I did with conditional formatting : I just added a new rule and then by clicking on the last rule type, I wrote "=a1=-1" and by clicking
on format/personnalized, I wrote for example "a". By doing so it works bu I do wanna keep the form "name-n".
Thank you for you help :)

[castak]

Here is my file to better undertsand what I want :)

[大灰狼1976]

I think i finally understand what you want.:rofl:
i write the explain and suggestion in worksheet named "Feuil2",Please refer to the attached.

[castak]

Ok thanks! However I won’t have the time to take a look at it by this week-end so I’ll keep you informed later ;)

[castak]

Here I am again!
I just took a look at your new proposition and it sounds good! Good idea ;)
Thanks again for your having helped me

[大灰狼1976]

That's all right.:yes

[大灰狼1976]

This is a simple example about intelligent input for you.

[castak]

Here is the new problem :think:

[大灰狼1976]

OK!

Sub test()
Dim x$, x1$, rng As Range, arr, O&, G&, B&, i&, clr&
Dim c1 As Range, c2 As Range, mess$, c1a As Range, c2a As Range
Retry:
x = InputBox("enter one/two number") 'sample: name-X-3-6-X-9-/-11-12
If x <> "" Then
O = RGB(255, 200, 50): G = RGB(0, 255, 0): B = RGB(0, 150, 255) 'Replacing color values with variables
Set rng = Sheets("Feuil1").Range("b7:b" & Sheets("Feuil1").[b65536].End(3).Row) 'assign cell area to rng
x = Replace(x, "name-X-/-", "2000-2000,") '**************added line**************
x = Replace(x, "name-/-X-", "-/-X-")
x = Replace(x, "name-/-", "") 'If the beginning is "name-/-" then delete it
'sample: no change happened --> name-X-3-6-X-9-/-11-12
x = Replace(x, "name-X-", ",,") 'sample: name-X-3-6-X-9-/-11-12 --> ,,3-6-X-9-/-11-12
x = Replace(x, "-/-X-", ",1000-1000,")
If x Like ",#*" Then x = Mid(x, 2) '**************added line**************
x = Replace(x, "-X-/-", ",2000-2000,")
x = Replace(x, "name", "1") 'If the beginning is "name-#" then Convert to "1-#"
'sample: no change happened --> ,,3-6-X-9-/-11-12
x = Replace(x, "-/-", ",") 'sample: ,,3-6-X-9-/-11-12 --> ,,3-6-X-9,11-12
x = Replace(x, "-X-", ",,,") 'sample: ,,3-6-X-9,11-12 --> ,,3-6,,,9,11-12
arr = Split(x, ",") 'sample: arr have 7 elements(blank,blank,3-6,blank,blank,9,11-12)
For i = 0 To UBound(arr) 'This cycle is used to transform elements and determine whether input is legal.
If arr(i) <> "" Then
If Not arr(i) Like "*-*" Then arr(i) = arr(i) & "-" & arr(i) 'sample: arr(blank,blank,3-6,blank,blank,9-9,11-12)
If Not IsNumeric(Replace(arr(i), "-", "")) Or Not arr(i) Like "*#-#*" Then
MsgBox "Input Error!": GoTo Retry 'If there is a mistake, start again.
End If
End If
Next i
x = Join(arr, ",") 'sample: ,,3-6,,,9,11-12 --> ,,3-6,,,9-9,11-12
x = Replace(x, "-", ",") 'sample: ,,3-6,,,9-9,11-12 --> ,,3,6,,,9,9,11,12
arr = Split(x, ",") 'sample: arr have 10 elements(blank,blank,3,6,blank,blank,9,9,11,12)
'now, each two elements represent a region. blank means filling green
rng.Interior.Color = B 'set rng color to blue
For i = 0 To UBound(arr) Step 2 'deal with two elements at a time
If arr(i) = "" Then 'if blank then
If i = 0 Then arr(i) = 1 Else arr(i) = arr(i - 1) + 1 'the previous blank = 1 or (the number in front of it + 1)
arr(i + 1) = arr(i + 2) - 1 'the next blank = the number behind it - 1
clr = G 'assign the green value to clr
Else 'if not blank then
If arr(i) = 1000 Then
arr(i) = arr(i + 2) - 1
arr(i + 1) = arr(i)
clr = G
ElseIf arr(i) = 2000 Then
If i = 0 Then
arr(i) = 1
arr(i + 1) = 1
Else
arr(i) = arr(i - 1) + 1
arr(i + 1) = arr(i)
End If
clr = G
Else
clr = O 'assign the orange value to clr
End If
End If
With rng
Set c1 = .Find("name-" & arr(i), lookat:=xlWhole) 'search for existence
Set c1a = c1
Do
If c1a = c1a.Offset(1) Then Set c1a = c1a.Offset(1) Else Exit Do
Loop
Set c2 = .Find("name-" & arr(i + 1), lookat:=xlWhole)
Set c2a = c2
Do
If c2a = c2a.Offset(1) Then Set c2a = c2a.Offset(1) Else Exit Do
Loop
If Not c1 Is Nothing And Not c2 Is Nothing Then 'if exists c1 and c2 then
Range(Range(c1, c1a), Range(c2, c2a)).Interior.Color = clr 'fill the cell area with color, clr has been assigned before
Else 'if not exists c1 or c2 then
mess = trans(mess, arr(i), arr(i + 1)) 'writing information to mess, trans() is custom functions
End If
End With
Set c1 = Nothing: Set c1a = Nothing: Set c2 = Nothing: Set c2a = Nothing
Next i
Else
mess = "you have canceled"
End If
If mess <> "" Then MsgBox mess
End Sub
Function trans(mess, s1, s2)
trans = mess & "the range containing ""name-" & s1 & """ & ""name-" & s2 & """ does not exist !!" & vbCrLf
End Function

[castak]

You are amazing!
2 last things and after I hope it'll be all right and I will stop bothering you ^^
I would like to add this case :
Rather than writing "name-4-/-8-12" with which I get name-1 to name-4 and name-8 to name-12 in orange and name-5 to name-7 in blue, write "name-4-/-/-/-8-12"
It is the same with -X- => "name-4-X-X-X-8-12" => name-1 to name-4 and name-8 to name-12 in orange name-5 to name-7 in green
Other example :
"name-3-/-/-X-/-X-X-10-12" => name-1 to name-3 and name-10 to name-12 in orange
name-4, name-5, name-7 in blue
name-6, name-8, name-9 in green

The last thing I want to add :
If "name-11" => name-1 to name-11 in orange and name-12 in blue
If "name-8" => name-1 to name-8 in orange and name-9 to name-12 in blue
If "name-11-X-" => name-1 to name-11 in orange and name-12 in green
If "name-8-X-" => name-1 to name-8 in orange and name-9 to name-12 in green

Have a nice day :hi:

[大灰狼1976]

This logic is not difficult to achieve, but it doesn't integrate well with the original logic. I have to find the universal logic. please give me time.

[castak]

All right no problem

[manomehar]

Just there is one problem , if D Column has a data it must not replace by the data on I Column .

[大灰狼1976]

hahahahahaha! Completed!:eek:

[castak]

Hi again!

I've got a new macro concerning my last message I sent you. It deals with my requirements but still some problems that's why I would like help if you don't mind :yes
File : NewCode1



Option Compare Text

Sub test()
Dim x As String, NbTiret As Variant
Dim DernCell As Boolean

Application.ScreenUpdating = False
Range("B7:B18").Interior.ColorIndex = xlNone
x = InputBox("enter one/two number")
x = Replace(x, "name", "")
NbTiret = Split(x, "-")

If UBound(NbTiret) = 1 Then
Select Case NbTiret(1)
Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12"
Range("B7:B" & NbTiret(1) + 6).Interior.Color = RGB(255, 200, 50) 'Orange
If UBound(NbTiret) < 12 Then Range("B" & NbTiret(1) + 7 & ":B18").Offset(1,0).Interior.Color = RGB(0, 150, 255)
Case Is = "/"
Range("B7:B18").Interior.Color = RGB(0, 150, 255)
Case Is = "X"
Range("B7:B18").Interior.Color = RGB(0, 255, 0)
End Select
ElseIf UBound(NbTiret) > 1 Then
Pos = 0
For i = 0 To UBound(NbTiret)
Select Case NbTiret(i)
Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12"
If NbTiret(i - 1) <> "/" And NbTiret(i - 1) <> "X" And NbTiret(i - 1) <> "" Then
Range(Cells(NbTiret(i - 1) + 6, "B"), Cells(NbTiret(i) + 6, "B")).Interior.Color = RGB(255, 200, 50)
ElseIf NbTiret(i - 1) <> "/" And NbTiret(i - 1) <> "X" And NbTiret(i - 1) = "" Then
Range(Cells(7, "B"), Cells(NbTiret(i) + 6, "B")).Interior.Color = RGB(255, 200, 50)
Else
Cells(NbTiret(i) + 6, "B").Interior.Color = RGB(255, 200, 50)
End If
Pos = NbTiret(i)
Case Is = "/"
Cells(Pos + 7, "B").Interior.Color = RGB(0, 150, 255)
Pos = Pos + 1
Case Is = "X"
Cells(Pos + 7, "B").Interior.Color = RGB(0, 255, 0) 'Vert
Pos = Pos + 1
End Select
Next i
Else
MsgBox "Erreur"
Exit Sub
End If

For i = 8 To 18
If Cells(i - 1, "B").Interior.Color = RGB(255, 200, 50) And Cells(i, "B").Interior.Color = 16777215 Then
Cells(i, "B").Interior.Color = RGB(0, 150, 255)
ElseIf Cells(i, "B").Interior.Color = 16777215 Then
DernCell = True
For j = i + 1 To 18
If Cells(j, "B").Interior.Color <> 16777215 Then
DernCell = False
End If
Next j
If DernCell = True Then
Cells(i, "B").Interior.Color = RGB(0, 150, 255)
Else
Cells(i, "B").Interior.Color = Cells(i - 1, "B").Interior.Color
End If
End If
Next
Range("B19").Interior.Color=VbWhite
End Sub

The logic is ok but I prefer your's with the method set c1= Find("name" ...) because if there are several same "name-n", it takes into account
all of these. However, with my new code, if I add some others "name-n", it doesn't work so that's why I'm locked... (File : ProblemNewCode)
Would you be able to give me some help and modify my code or propose a complete new solution ?

Here is a small recap of my requirements => File : Requirements


Thanks :yes

[castak]

Sorry I didn’t see you’re new message! I was just working on a new code but yours is
much more good! It works perfectly ! You’re so nice thank you very much guy ��

[大灰狼1976]

When the end of the input string is "X", it will prompt.
for example: "name-11-X"
This is the modified code.

Private Sub CommandButton1_Click()
Dim x$, arr, arr1, i&, j&, mx&, s$, r&, b1 As Boolean, n&, rng As Range
Dim O&, G&, B&, Clr&
Dim c1 As Range, c2 As Range, mess$, c1a As Range, c2a As Range, s1$, s2$
Retry:
x = InputBox("enter one/two number")
If x = "" Then MsgBox "you have canceled": Exit Sub
O = RGB(255, 200, 50): G = RGB(0, 255, 0): B = RGB(0, 150, 255)
Set rng = [a69].CurrentRegion
rng.Interior.Color = B
arr = rng: mx = Split(arr(UBound(arr), 1), "-")(1)
x = Replace(x, "name", 0)
arr = Split(x, "-")
Do
b1 = False
If Right(x, 1) = "/" Then
x = Left(x, Len(x) - 2)
b1 = True
End If
Loop Until b1 = False
If Right(x, 1) = "X" Then x = x & "-" & mx + 1
arr = Split(x, "-")
For i = 0 To UBound(arr)
s = arr(i)
If IsNumeric(s) Then n = n + 1 Else n = 0
If n = 3 Or (s <> "/" And s <> "X" And Not IsNumeric(s)) Then
MsgBox "Input error!"
GoTo Retry
End If
Next i
ReDim arr1(UBound(arr))
arr1(0) = Array(0, O)
For i = 1 To UBound(arr)
s = arr(i)
If IsNumeric(s) Then
arr1(i) = Array(s, O)
ElseIf s = "X" Then
If IsNumeric(arr(i - 1)) Then
arr1(i) = Array(arr(i - 1) + 1, G)
Else
arr1(i) = Array("?", G)
End If
Else
If IsNumeric(arr(i - 1)) Then
arr1(i) = Array(arr(i - 1) + 1, B)
Else
arr1(i) = Array("?", B)
End If
End If
Next i
Do
b1 = False
For i = 1 To UBound(arr1) - 1
If arr1(i)(0) = "?" Then
If arr1(i - 1)(1) = O Then
arr1(i)(0) = arr1(i - 1)(0) + 1
b1 = True
GoTo 1
End If
If arr1(i + 1)(1) = O Then
arr1(i)(0) = arr1(i + 1)(0) - 1
b1 = True
GoTo 1
End If
If arr1(i - 1)(1) = G And IsNumeric(arr1(i - 1)(0)) Then
arr1(i)(0) = arr1(i - 1)(0) + 1
b1 = True
GoTo 1
End If
If arr1(i + 1)(1) = G And IsNumeric(arr1(i + 1)(0)) Then
arr1(i)(0) = arr1(i + 1)(0) - 1
b1 = True
GoTo 1
End If
If arr1(i + 1)(1) = B And IsNumeric(arr1(i + 1)(0)) Then
arr1(i)(0) = arr1(i + 1)(0) - 1
b1 = True
GoTo 1
End If
If arr1(i + 1)(1) = B And IsNumeric(arr1(i - 1)(0)) Then
arr1(i)(0) = arr1(i - 1)(0) + 1
b1 = True
GoTo 1
End If
End If
1
Next i
Loop Until b1 = False
For i = 0 To UBound(arr1)
s1 = "": s2 = ""
If i = UBound(arr1) Then
If arr1(i)(0) <> mx + 1 Then
Clr = O
s1 = "name-" & arr1(i)(0)
s2 = s1
Else
s1 = ""
End If
Else
If arr1(i)(1) = O Then
Clr = O
If i = 0 Then s1 = "name-1" Else s1 = "name-" & arr1(i)(0)
If i = 0 And arr1(i + 1)(1) = B Then s1 = ""
If arr1(i + 1)(1) = O Then
If i = mx Then s2 = "name-" & mx Else s2 = "name-" & arr1(i + 1)(0)
i = i + 1
Else
s2 = s1
End If
ElseIf arr1(i)(1) = G Then
Clr = G
s1 = "name-" & arr1(i)(0)
If arr1(i + 1)(1) = O Then
s2 = "name-" & arr1(i + 1)(0) - 1
ElseIf arr1(i + 1)(1) = G Then
For j = i + 1 To UBound(arr1)
If arr1(j)(1) <> G Then Exit For
Next j
s2 = "name-" & arr1(j - 1)(0)
i = j - 1
Else
s2 = s1
End If
End If
End If
If s1 <> "" And s2 <> "" Then
Set c1 = rng.Find(s1, lookat:=xlWhole)
Set c2 = rng.Find(s2, lookat:=xlWhole)
Set c2a = c2
Do
If c2 Is Nothing Then Exit Do
If c2a = c2a.Offset(1) Then Set c2a = c2a.Offset(1) Else Exit Do
Loop
If Not c1 Is Nothing And Not c2 Is Nothing Then
Range(c1, c2a).Interior.Color = Clr
Else
mess = trans(mess, s1, s2)
End If
End If
Next i
If mess <> "" Then MsgBox mess
End Sub
Function trans(mess, s1, s2)
trans = mess & "the range containing ""name-" & s1 & """ & ""name-" & s2 & """ does not exist !!" & vbCrLf
End Function

[castak]

All right no problem!

[castak]

Hi 大灰狼1976 (http://www.vbaexpress.com/forum/member.php?70849-%26%2322823%3B%26%2328784%3B%26%2329436%3B1976) how are you !?

I come back with the previous code that I would like to change a bit.
Initially, I had name-1 to name-12 from Range("B7") to Range("B18").
But now, if I added name before name-1, do you know how I could I do so that name be taken into account if I enter "name" in my inputbox ?
And then rather than having name-1 to name-12 from Range("B7") to Range("B18"), I would like to get name in Range("B7") and then name-1 in Range("C7") to name-12 in Range("C17"). I tried to set 2 different ranges (1 for name and the other for name-1 to name-12) but it doesn't works

[大灰狼1976]

Hi castak!
Sorry I don't quite understand what you mean.
Can you give me an example?:think:

[castak]

All right here is a file of me new requirements :yes

[大灰狼1976]

B7 cell is always orange no matter what input?

[castak]

Yes that's it!

[大灰狼1976]

Done!

[castak]

Perfect thanks!