Macro for Plotting Coordinates within a rectangle

3PlankWalker

Board Regular
Joined
Sep 18, 2014
Messages
76
I have written this code for Plotting Coordinates within a rectangle of size b by d, which is working but is there a better way to write this code.

Is there a better way to write this code.
Code:
Option Explicit
'ReinforceCoordinates = RCoordinates
Sub RCoordinates()
Dim b As Double, d As Double, EdgeDist As Double
Dim SpacingX As Double, SpacingY As Double
Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, Count As Integer
Dim NoColumn As Integer, NoRow As Integer
b = Range("D14").Value
d = Range("B14").Value
EdgeDist = Range("F14").Value
NoColumn = 3
NoRow = 3
Count = 17
SpacingX = (b - 2 * EdgeDist) / (NoColumn - 1)
SpacingY = (d - 2 * EdgeDist) / (NoRow - 1)
Range("AA17:AB1000").ClearContents
'Face 1
For i = 0 To NoColumn - 1
Cells(Count, 27) = EdgeDist + SpacingX * i
Cells(Count, 28) = EdgeDist
Count = Count + 1
Next i
'Face 2
For j = 0 To NoRow - 1
Cells(Count, 27) = EdgeDist
Cells(Count, 28) = EdgeDist + SpacingY * j
Count = Count + 1
Next j
'Face 3
For k = 0 To NoColumn - 1
Cells(Count, 27) = EdgeDist + SpacingX * k
Cells(Count, 28) = d - EdgeDist
Count = Count + 1
Next k
'Face 4
For l = 0 To NoRow - 1
Cells(Count, 27) = b - EdgeDist
Cells(Count, 28) = EdgeDist + SpacingY * l
Count = Count + 1
Next l
End Sub


Thanks
 

Some videos you may like

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

pgc01

MrExcel MVP
Joined
Apr 25, 2006
Messages
19,838
Hi

I see that some of the coordinates are repeated in your result. Is this how you want it?
 

3PlankWalker

Board Regular
Joined
Sep 18, 2014
Messages
76
If we can remove the Repeating coordinates It will be good, if not also ok.

Thanks
 

pgc01

MrExcel MVP
Joined
Apr 25, 2006
Messages
19,838
This would be another option:

Code:
'ReinforceCoordinates = RCoordinates
Sub RCoordinates1()
Dim dWidth As Double, dHeight As Double, dEdgeDist As Double
Dim dSpacingX As Double, dSpacingY As Double
Dim lRow As Long, lColumn As Long, lCount As Long

Const lNoColumn As Long = 3
Const lNoRow As Long = 3

dWidth = Range("D14").Value
dHeight = Range("B14").Value
dEdgeDist = Range("F14").Value

dSpacingX = (dWidth - 2 * dEdgeDist) / (lNoColumn - 1)
dSpacingY = (dHeight - 2 * dEdgeDist) / (lNoRow - 1)

Range("AA17:AB1000").ClearContents
lCount = 17

For lRow = 0 To lNoRow - 1
    For lColumn = 0 To lNoColumn - 1
        If lRow = 0 Or lRow = lNoRow - 1 Or lColumn = 0 Or lColumn = lNoColumn - 1 Then
            Cells(lCount, "AA") = dEdgeDist + dSpacingX * lColumn
            Cells(lCount, "AB") = dEdgeDist + dSpacingY * lRow
            lCount = lCount + 1
        End If
    Next lColumn
Next lRow

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,109,043
Messages
5,526,434
Members
409,701
Latest member
nitmani

This Week's Hot Topics

Top