VBA draw table line borders every 18 count

[harky]

I not sure if it possible?

VBA draw table line border every 18 count from col T to AF


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]COL T[/TD]
[TD]COL U[/TD]
[TD]COL V[/TD]
[TD]COL W[/TD]
[TD]COL X[/TD]
[TD]COL Y[/TD]
[TD]COL Z[/TD]
[TD]COL AA[/TD]
[TD]COL AB[/TD]
[TD]COL AC[/TD]
[TD]COL AD[/TD]
[TD]COL AE[/TD]
[TD]COL AF[/TD]
[/TR]
[TR]
[TD]ROW1[/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]A[/TD]
[TD]D[/TD]
[TD]D[/TD]
[TD]G[/TD]
[/TR]
[TR]
[TD]ROW2[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]6[/TD]
[TD]7[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ROW3[/TD]
[TD]12[/TD]
[TD]10[/TD]
[TD]19[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ROW4[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]7[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ROW5[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]6[/TD]
[TD]7[/TD]
[TD]8[/TD]
[TD]9[/TD]
[TD]10[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ROW6[/TD]
[TD]5[/TD]
[TD]3[/TD]
[TD]5[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]



So row 1 & 2 is add up is 20 count.
It will draw a table border below

Row 4, 5, 6 add up is 18 count
It will draw a table border below

 

[Peter_SSs]

Can change the line to thicker type?

Sorry, I overlooked this with my previous reply. Try this code instead.

Sub Line_After_Every_18()
  Dim a As Variant
  Dim i As Long, j As Long, k As Long, uba2 As Long
  
  a = Range("T22", Range("T" & Rows.Count).End(xlUp)).Resize(, 13).Value
  uba2 = UBound(a, 2)
  For i = 1 To UBound(a)
    For j = 1 To uba2
      If Len(a(i, j)) Then k = k + 1
      If k = 18 Then
        With Range("T" & i + 21).Resize(, 13).Borders(xlEdgeBottom)
          .LineStyle = xlContinuous
          .Weight = xlThick
        End With
        k = 0
        Exit For
      End If
    Next j
  Next i
End Sub

 

[harky]

Thanks, but it has error @ last line.

Erase Arr

Same macro with variable range

Option Explicit


Sub test()
Dim i%, k%, Arr(), Sub_Arr
k = 1
Const my_max = 50 [SIZE=2][COLOR=#ff0000]'change to wanted number[/COLOR][/SIZE]
For i = 1 To 10000
    ReDim Preserve Arr(1 To k)
    If i = 1 Then
     Arr(i) = 2
    Else
     Arr(i) = IIf(k Mod 2 = 1, Arr(i - 1) + 2, Arr(i - 1) + 4)
    End If
 If Arr(i) > my_max Then Exit For
     k = k + 1
 Next
 Cells(2, "T").Resize(20, 10000).Borders.LineStyle = 0
 For Each Sub_Arr In Arr
    With Cells(Sub_Arr, "T").Resize(, 13).Borders(9)
     .LineStyle = 1
     .Weight = 4
    End With
 Next
End Sub
Erase Arr

 

[Peter_SSs]

Thanks, but it has error @ last line.

Erase Arr

Also, if mine does what you want, then this one doesn't.

 

[harky]

Yes, ur does what i want.. Thanks both

Also, if mine does what you want, then this one doesn't.

 

[Peter_SSs]

Yes, ur does what i want.. Thanks both

You're welcome.

 

[salim hasan]

Thanks, but it has error @ last line.

Erase Arr

Erase Arr was entered by mistake after the End Sub
it must be before

 

[harky]

Sorry, my mistake. Pls ignore my post.

Notice there is hidden row.

You're welcome.