I'm trying to create a tool to generate a Continuity and Isolation Check.
This is the sequence I would like:
I'm basically trying to create a sequence on the right side of my table that generates a diminishing pattern. 1 to 5, 2 to 5, 3 to 5 etc.
On the left, every set of numbers will be next to 1, then 2, etc. Like the picture.
Here is my code so far. There is some sequence in here I can't figure out how to create a code for:
Private Sub CommandButton1_Click()
Dim i As Integer
For i = 1 To 5
Cells(i, 4).Value = i '' 1 -15 starting after the 15th integer
Cells(i 4, 4).Value = i '' 2 -15 starting after the 15th integer
Cells(i 7, 4).Value = i '' 3 -15 starting after the 15th integer
Cells(i 9, 4).Value = i
Cells(i 10, 4).Value = i
Next i
End Sub
What can I try next?
CodePudding user response:
You need 2 nested loops:
n = 5
row = 1
for i = 1 to n
for j = i to n
cells(row, 1) = i
cells(row, 2) = j
row = row 1
next
Next
CodePudding user response:
Array version which is faster than writing to cells repeatedly in the loop:
Option Explicit
Private Sub Test()
GenerateDiminishingPattern 5
End Sub
Private Sub GenerateDiminishingPattern(argLimit As Long)
Const startRow As Long = 1
Const repeatCol As Long = 1 'Column A
Const diminishingCol As Long = 4 'Column D
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'Change the sheet name accordingly
'=== Uncomment if you need to apply strikethrough to the first value of each loop
'ws.Columns(repeatCol).Clear
'ws.Columns(diminishingCol).Clear
'=== Determine the size for array based on sum of consecutive number
Dim outputSize As Long
outputSize = (argLimit * (argLimit 1)) / 2
Dim repeatOutput() As Long
Dim diminishingOutput() As Long
ReDim repeatOutput(1 To outputSize, 1 To 1) As Long
ReDim diminishingOutput(1 To outputSize, 1 To 1) As Long
Dim i As Long
Dim j As Long
Dim rowIndex As Long
rowIndex = 1
For i = 1 To argLimit
'=== Uncomment if you need to apply strikethrough to the first value of each loop
'ws.Cells(startRow, repeatCol).Offset(rowIndex - 1).Font.Strikethrough = True
'ws.Cells(startRow, diminishingCol).Offset(rowIndex - 1).Font.Strikethrough = True
For j = i To argLimit
repeatOutput(rowIndex, 1) = i
diminishingOutput(rowIndex, 1) = j
rowIndex = rowIndex 1
Next j
Next i
'Write output to worksheet
ws.Cells(startRow, repeatCol).Resize(outputSize).Value = repeatOutput
ws.Cells(startRow, diminishingCol).Resize(outputSize).Value = diminishingOutput
Erase repeatOutput
Erase diminishingOutput
Set ws = Nothing
End Sub