vba about patterns, code no return

[montecarlo2012]

Hi all
working on

Sub ff()
Dim i%, j%, k%, l%
Dim lines%, space%
lines = 15
space = 0
         For i = 1 To lines ' this loop is used to print lines
               For j = 1 To space ' this loop is used to print space in a line
                       Cells(i, j).Value2 = "   "
                           For k = 1 To lines ' this loop is used to print numbers in a line
                                       If j <= (lines - i) Then
                                       Cells(i, j).Value2 = j
                                       Else
                                       Cells(i, j).Value2 = "*"
                                       While j > 0 'this loop is used to print numbers in a line
                                       If j > (lines - i) Then
                                       Cells(i, j).Value2 = " * "
                                       Else
                                       Cells(i, j).Value2 = j
                                       If ((lines - i) > 9) Then 'this loop is used to increment space
                                       space = space + 1
                                       Cells(i, j).Value2 = ""
                            Next k
               Next j
         Next i
End Sub

No return or error messages..

Output expected

Please
Your input will be appreciated.
Thank you for reading this.

 

[Trixterz]

You should change the value of space to equal 1 as this might break your code or cause the user to go into infinite loop.

space = [B]1[/B]
         For i = 1 To lines ' this loop is used to print lines
               For j = 1 To space ' this loop is used to print space in a line

 

[montecarlo2012]

Sorry in the spreadsheet is:

Thanks.

 

[offthelip]

Deleted I missed your requirement

 

[offthelip]

I finaly got there, try this:

Sub ff()
Dim i%, j%, k%, l%
Dim lines%, space%
lines = 15
srt = 0
space = lines
         For i = 1 To lines ' this loop is used to print lines
               For j = 1 To lines ' this loop is used to print space in a line
                    If j > 9 Then
                       jj = 10 + (j - 10) * 2
                    Else
                      jj = j
                    End If
                    If j > space Then
                       If j > 9 Then
                        Cells(i, jj + srt) = "*"
                        Cells(i, jj + srt + 1) = "*"
                        Cells(i, 42 - jj - srt + 1) = "*"
                        Cells(i, 42 - jj - srt) = "*"
                       Else
                       Cells(i, jj + srt) = "*"
                        Cells(i, 42 - jj - srt) = "*"
                       End If
                    Else
                       If j > 9 Then
                        Cells(i, jj + srt) = 1
                        Cells(i, jj + srt + 1) = j - 10
                        Cells(i, 42 - jj - srt) = 1
                        Cells(i, 42 - jj - srt + 1) = j - 10
                       Else
                       Cells(i, jj + srt) = j
                       Cells(i, 42 - jj - srt) = j
                       End If
                    End If
               Next j
               If i < 7 Then
                srt = srt + 1
               End If
               space = space - 1
         Next i
 
 
End Sub

 

[offthelip]

I found an error try this one, :

Sub ff()
Dim i%, j%, k%, l%
Dim lines%, space%
lines = 15
srt = 0
space = lines
         For i = 1 To lines ' this loop is used to print lines
               For j = 1 To lines ' this loop is used to print space in a line
                    If j > 9 Then
                       jj = 10 + (j - 10) * 2
                    Else
                      jj = j
                    End If
                    If j > space Then
                       If j > 9 Then
                        Cells(i, jj + srt) = "*"
                        Cells(i, jj + srt + 1) = "*"
                        Cells(i, 42 - jj - srt + 1) = "*"
                        Cells(i, 42 - jj - srt) = "*"
                       Else
                       Cells(i, jj + srt) = "*"
                        Cells(i, 42 - jj - srt) = "*"
                       End If
                    Else
                       If j > 9 Then
                        Cells(i, jj + srt) = 1
                        Cells(i, jj + srt + 1) = j - 10
                        Cells(i, 42 - jj - srt) = 1
                        Cells(i, 42 - jj - srt + 1) = j - 10
                       Else
                       Cells(i, jj + srt) = j
                       Cells(i, 42 - jj - srt + 1) = j  ' this line has changed
                       End If
                    End If
               Next j
               If i < 7 Then
                srt = srt + 1
               End If
               space = space - 1
         Next i
 
 
End Sub

 

[montecarlo2012]

offthelip. Excellent job, work perfect Thank you so much, I click as solution and click like also.
great code.

 

[Rick Rothstein]

Here is a more compact, generalized solution that will work for any number, not just 15... simply change the number assigned to the Count variable (code line is highlighted in red) and run the macro.

Sub Pattern()
  Dim X As Long, Count As Long, Nums As Variant
  Count = 15
  ActiveSheet.UsedRange.Clear
  For X = 0 To Count - 1
    Nums = Split(StrConv(Join(Evaluate("TRANSPOSE(ROW(1:" & Count - X & "))"), "") & _
           Evaluate("REPT(""*""," & 2 * X & ")") & _
           Join(Evaluate("TRANSPOSE(" & Count + 1 - X & "-ROW(1:" & Count - X & "))"), ""), vbUnicode), Chr(0))
    Cells(X + 1, IIf(Count - X > 8, X + 1, Count - 8)).Resize(, UBound(Nums)) = Nums
  Next
End Sub

 

[montecarlo2012]

Rick Rothstein, thank you, great code.