Adding Borders Depending on Value

[JohnHarmeston]

Hey,

I've been having issues trying to set this up so was hoping someone could let me know how badly I'm messing up.
　
I have on sheet one, B15, a drop box that shows from:
- "Single"
- "Multi x2"
- "Multi x3"
etc until x10
　
and on another sheet, information that fills in the C column if x2 is selected, D column if the x3 column is selected etc and to remove all information should the lesser multi / single was selected, ie the D column onwards is deleted should you select a x2 or less.
　
What I'm wanting to add however are borders that surround the information should the correct selection be chosen; but with gaps in between some rows; like C19:C26 to be bordered, then C29:C33 and so on (The spacing isn't consistant however). And also to unhide the appropriate columns and re-hide them automatically.
　
And also when you choose the lesser multi size, to then delete the borders that no longer have any information in.
　
I've pasted the code below, any help would be appreciated! And sorry for the novel, haha.

Sub BorderMultix2()
    Dim rng As Range
    Set rng1 = Range("'Case Creation'!C21:C26")
    Set rng2 = Range("'Case Creation'!C29:C33")
    Set rng3 = Range("'Case Creation'!C35:C37")
    Set rng4 = Range("'Case Creation'!C45:C48")
If Range("'ID&V (Stub)'!B15").Value = "Single" Then
    With rng1.Borders.LineStyle = xlNone
    With rng2.Borders.LineStyle = xlNone
    With rng3.Borders.LineStyle = xlNone
    With rng4.Borders.LineStyle = xlNone
    End With
    End With
    End With
    End With
    
Else
    With rng1.Borders
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    With rng2.Borders
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    With rng3.Borders
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    With rng4.Borders
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With
    End With
    End With
    End With
End If
End Sub

 

[Fluff]

Firstly you can re-write your code like

Sub BorderMultix2()
   Dim Rng1 As Range
   Set Rng1 = Sheets("Case Creation").Range("C21:C26,c29:c33,c35:c37,c45:c48")
   If Sheets("ID&V (Stub)").Range("B15").Value = "Single" Then
        Rng1.Borders.LineStyle = xlNone
   Else
       With Rng1.Borders
           .LineStyle = xlContinuous
           .Color = vbBlack
           .Weight = xlThin
       End With
   End If
End Sub

Are the ranges the same for each value, just different columns?

 

[JohnHarmeston]

Ah great, thanks for that ! I'll shorten it now.
　
As for the question; yes. I've set it up so it will always be the same rows for the info, but just one column along.

 

[Fluff]

Do the rows not included in those ranges (ie 28:28,34,38:44) have borders?

 

[Fluff]

How about

Sub BorderMultix2()
   Dim Rng As Range
   Dim i As Long, x As Long
   Set Rng = Sheets("Case Creation").Range("C21:C26,C29:C33,C35:C37,C45:C48")
   Rng.EntireRow.Borders.LineStyle = xlNone
   With Sheets("ID&V (Stub)").Range("B15")
      If .Value = "Single" Then x = 1 Else x = Split(.Value, "x")(1)
   End With
   For i = 0 To x - 1
        With Rng.Offset(, i).Borders
           .LineStyle = xlContinuous
           .Color = vbBlack
           .Weight = xlThin
       End With
   Next i
End Sub

 

[JohnHarmeston]

Hey,

　
Sorry for the late reply! Can only be working on this project at certain times.
　
I've added that now and it works! But since it was initially deleting the borders in A&B, I just did a little switch around with the ranges.
　
Thanks for the help! Much appreciated.

Sub BorderMultix2()
   Dim Rng As Range
   Dim i As Long, x As Long
   Set Rng = Sheets("Case Creation").Range("A21:B26,A29:B33,A35:B37,A45:B48")
   Rng.EntireRow.Borders.LineStyle = xlNone
   With Sheets("ID&V (Stub)").Range("B15")
      If .Value = "Single" Then x = 1 Else x = Split(.Value, "x")(1)
   End With
   For i = 0 To x - 1
        With Rng.Offset(, i).Borders
           .LineStyle = xlContinuous
           .Color = vbBlack
           .Weight = xlThin
       End With
   Next i
End Sub

 

[Fluff]

Glad you sorted it & thanks for the feedback