Repeat even numbers in an array VBA-CodePudding

I'm trying to make a macro for where a user inputs a number and the even numbers are repeated in an array. I have got the code for repeating the numbers from 0-n (n being the number inputted). However, I don't know how to go about repeating the even numbers twice.

Sub Macro3()

For n = 1 To Worksheets("Sheet1").Cells(1, 2)   1

    Cells(2, 1   n).Select
    ActiveCell.FormulaR1C1 = (n - 1)
    
Next

End Sub

Below is the output Current code vs what I really want

CodePudding user response：

Write an Array of Integers

Writes an array of integers between 0 and the specified value in cell B1 to a row range starting from B2. Even numbers are written twice.

Option Explicit

Sub WriteArrayOfIntegers()
    Const ProcTitle As String = "Write Array of Integers"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
    
    ' Create a reference to the source cell.
    Dim sCell As Range: Set sCell = ws.Range("B1")
    
    ' Write the value of the source cell to a variable.
    Dim sValue As Variant: sValue = sCell.Value
    
    Dim Last As Long
    
    ' Validate the source cell value.
    If IsNumeric(sValue) Then ' is a number
        Last = Abs(CLng(sValue)) ' positive ('Abs'), whole ('CLng')
    Else ' is not a number
        MsgBox "The value in cell '" & sCell.Address(0, 0) & "' ('" _
            & sValue & "' is not a number.", vbCritical, ProcTitle
        Exit Sub
    End If
    
    ' Create a reference to the first destination cell.
    Dim dCell As Range: Set dCell = ws.Range("B2"): dCell.Value = 0
    
    Dim Size As Long: Size = 1
    
    Dim n As Long
    
    ' Loop through the numbers and apply alternating row size (1 or 2)
    ' and column offset (2 or 1) before writing.
    For n = 1 To Last
        Set dCell = dCell.Offset(, Size) ' define next first cell
        Size = 2 - n Mod 2 ' calculate the size (Odd = 1, Even = 2)
        dCell.Resize(, Size).Value = n ' write to the resized row range
    Next n
    
    ' Clear the range to the right of the last cell to remove any previous data.
    Dim crrg As Range
    With dCell.Offset(, Size) ' define next first cell
        ' Define the range from the next first to the last worksheet cell
        ' in the row.
        Set crrg = .Resize(, ws.Columns.Count - .Column   1)
    End With
    crrg.Clear ' or crrg.ClearContents
    
    MsgBox "Array of numbers written.", vbInformation, ProcTitle

End Sub

CodePudding user response：

Your code is realy ok, just add question is number even and one more variable to see where to write. Also just change n loop from 0:

Sub Macro3()

For n = 0 To Worksheets("Sheet1").Cells(1, 2)
    
    a = a   1
    Cells(2, 2   a).Select
    ActiveCell.FormulaR1C1 = n

    'check if number is even and check if a > 1 because we don't whant to repeat 0
    If n Mod 2 = 0 And a > 1 Then
        a = a   1
        Cells(2, 2   a).Select
        ActiveCell.FormulaR1C1 = n
    End If
Next

End Sub