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

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Hi

I see that some of the coordinates are repeated in your result. Is this how you want it?
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,205
Members
448,554
Latest member
Gleisner2

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
Back
Top