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.
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.

[大灰狼1976]

This is a simple example about intelligent input for you.

[castak]

Here is the new problem

[大灰狼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

[大灰狼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