diamond shaped in vba

**rishikrsaw** · 06-07-2017, 08:52 AM

Hello All,

Please help me to create below shape in excel sheet using VBA

*
**
***
****
*****
****
***
**
*excel forum.png excel forum.xlsx

**MickG** · 06-07-2017, 09:30 AM

Try this:-

Sub MG07Jun09
Dim n As Long, c As Long
For n = 1 To 10
    With Range("A" & n)
        If n <= 10 / 2 Then
            c = c + 1
        Else
            c = c - 1
        End If
        If c > 0 Then .Resize(, c).Value = "*"
    End With
Next n
End Sub

Regards Mick

**leelnich** · 06-07-2017, 10:19 AM

Or this: NOTE: Worksheet .png graphic added to Original Post AFTER this was written.

Sub HalfDiamond()

    Dim rw As Long
    Dim n As Long
    
    For rw = 1 To 9
        n = 5 - Abs(5 - rw)
        Range("A" & rw).Resize(, n).Value = "*"
    Next rw
    
End Sub

Please click the Add Reputation star below any helpful posts, and if you have your answer, mark your thread as SOLVED (Thread Tools up top). Thanks!-Lee

**leelnich** · 06-07-2017, 10:43 AM

And just for fun, this does the WHOLE DIAMOND:

Sub WholeDiamond()

    Dim rw As Long
    Dim n As Long
    
    With Range("A5")
    For rw = -4 To 4
        n = Abs(rw)
        .Offset(rw, n).Resize(, 9 - n - n).Value = "*"
    Next rw
    End With
    
End Sub

Please click the Add Reputation star below any helpful posts, and if you have your answer, mark your thread as SOLVED (Thread Tools up top). Thanks!-Lee

**rishikrsaw** · 06-08-2017, 03:53 AM

excel forum.png

i WANT IN THIS FORMAT

**MickG** · 06-08-2017, 05:20 AM

Try:-

Sub MG08Jun46
Dim n As Long, num As Long
For n = 1 To 9
   num = 5 - Abs(5 - n) 'nice one leelnich!!!
   Range("D" & n + 4).Value = Application.Rept("*", num)
Next n
Range("D4:D13").HorizontalAlignment = xlCente
End Sub

Regards Mick

**rishikrsaw** · 06-08-2017, 02:58 AM

I want to * as below excel forum.png excel forum.png

**leelnich** · 06-08-2017, 07:53 AM

Or this, with a twist:

Sub WholeDiamond2()
With Range("D4:D12")
    .HorizontalAlignment = xlCenter
    .Formula = "=REPT(""*"",5-ABS(ROW()-8))"
    .Value = .Value
End With
End Sub

This WORKSHEET FORMULA could be used without VBA:

=REPT("*",5-ABS(ROW()-8))

...where 5 is the maximum string length, and 8 is the row where it occurs. Row number must be greater than max. length.

Please click the Add Reputation star below any helpful posts, and if you have your answer, mark your thread as SOLVED (Thread Tools up top). Thanks!-Lee

**nigelog** · 06-08-2017, 08:23 AM

Adding to leelnich code the border I think is required

Sub WholeDiamond2()
With Range("D4:D13")
    .HorizontalAlignment = xlCenter
    .Formula = "=REPT(""*"",5-ABS(ROW()-9))"
    .Value = .Value
End With
With Range ("D5:D13")
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
End Sub

**leelnich** · 06-08-2017, 09:06 AM

Just realized the range was off. If borders required, fold into same With block. (Nod to nigelog.)

Sub WholeDiamond3()
With Range("D4:D12")

    .HorizontalAlignment = xlCenter
    .Formula = "=REPT(""*"",5-ABS(ROW()-8))"
    .Value = .Value
    
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous

End With
End Sub

Please click the Add Reputation star below any helpful posts, and if you have your answer, mark your thread as SOLVED (Thread Tools up top). Thanks!-Lee

**jindon** · 06-08-2017, 09:30 AM

Select the vertically consecutive cells and run the code.

Sub test()
    Dim i As Long, n As Long, t As Long
    With Selection
        .CurrentRegion.Clear
        .HorizontalAlignment = xlCenter
        .Borders.Weight = 2
        n = .Rows.Count + 1
        t = Application.RoundUp(n / 2, 0)
        For i = 1 To t
            .Cells(i) = String(i, "*")
            .Cells(n - i, 1) = String(i, "*")
        Next
    End With
End Sub

diamond shaped in vba

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

diamond shaped in vba

Re: diamond shaped in vba

Re: diamond shaped in vba

Re: diamond shaped in vba

Re: diamond shaped in vba

Re: diamond shaped in vba

Re: diamond shaped in vba

Re: diamond shaped in vba

Re: diamond shaped in vba

Re: diamond shaped in vba

Re: diamond shaped in vba

Thread Information

Users Browsing this Thread

Similar Threads

bell - shaped curve

Q: how to make stack bar chart with total values and a diamond marker for each column ?

Normal distribution shaped graph

S-Shaped Trendline - Please Help

[SOLVED] Blue diamond shape in a cell

Is it possible to get Oval shaped Bubbles?

eliminate exclamation point in yellow diamond

Excel L-shaped Text Box

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions