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
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

pgc01

MrExcel MVP
Joined
Apr 25, 2006
Messages
19,887
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,887
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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,712
Messages
5,833,266
Members
430,200
Latest member
ADLHMA2022

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top