CODEWITHSUNDEEP
vbaexcel
RL001
RL001

Reputation: 169

Loop and Offset

I'm new to vba and this site and need a little guidance. I'm attempting to read a dynamically created range from another sheet. Using this range populate it in another sheet with an offset of four rows after each row in the range. Each row created by the offset should have a string value inserted.

example.

1000                      /populated from range
sting insert              /populated from offset 1 
another string insert     /populated from offset 2
a final string insert     /populated from offset 3

Before update:

2000    ACCOUNT NAME
2001    ACCOUNT NAME
2002    ACCOUNT NAME
2003    ACCOUNT NAME

After Update:

2000    ACCOUNT NAME
    new string 1
    new string 2
    new string 3

2001    ACCOUNT NAME
    new string 1
    new string 2
    new string 3

2002    ACCOUNT NAME
    new string 1
    new string 2
    new string 3

I've tried a few different approaches however nothing is working the way i desire. The code below works as expected in getting the range and populating the destination sheet but the offset is giving me a headache. any help/guidance will be greatly appreciated.

code so far.

 Sub Program_Array()
    Dim rngToCopy As Range
    Dim C As Range
    Dim varArray As Variant
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim LastRow As Long

     Set ws1 = Sheets("Index")
     Set ws2 = Sheets("FinalSheet")

        LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

            With ThisWorkbook
              et rngToCopy = .Worksheets("Index").Range("A2", ws1.Cells(LastRow, "A"))
              varArray = rngToCopy.Value

              For Each C In rngToCopy
              C.Offset(3, 0).Value = C.Value
              Next C

              ws2.Range("A5").Resize(UBound(varArray, 1), UBound(varArray, 2)).Value = varArray

            End With

        Set rngToCopy = Nothing: Set ws1 = Nothing: Set ws2 = Nothing

    End Sub

Upvotes: 2

Views: 293

Answers (1)

kamila
kamila

Reputation: 74

if i understand correctly, you want the update on the final sheet? try this:

Sub Program_Array()
Dim rngToCopy As Range
Dim C As Range
Dim varArray As Variant
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LastRow As Long
Dim i As Long

Set ws1 = Sheets("Index")
Set ws2 = Sheets("FinalSheet")

    LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

      Set rngToCopy = ws1.Range("A2", ws1.Cells(LastRow, "A"))
      Set rngFinal = ws2.Range("A2", ws2.Cells(LastRow * 4, "A"))

      For i = 1 To rngToCopy.Rows.Count
        rngFinal((i - 1) * 4 + 1, 1) = rngToCopy(i, 1)
        rngFinal((i - 1) * 4 + 2, 1) = "string 1"
        rngFinal((i - 1) * 4 + 3, 1) = "string 2"
        rngFinal((i - 1) * 4 + 4, 1) = "string 3"

      Next i

End Sub

edit: or if you really want to use offset:

Dim LastRow As Long
Dim i As Long

Set ws1 = Sheets("Index")
Set ws2 = Sheets("FinalSheet")

    LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

      Set rngToCopy = ws1.Range("A2", ws1.Cells(LastRow, "A"))
      Set rngFinal = ws2.Range("A1")

      For i = 1 To rngToCopy.Rows.Count
        rngFinal.Offset((i - 1) * 4 + 1, 0) = rngToCopy(i, 1)
        rngFinal.Offset((i - 1) * 4 + 2, 0) = "string 1"
        rngFinal.Offset((i - 1) * 4 + 3, 0) = "string 2"
        rngFinal.Offset((i - 1) * 4 + 4, 0) = "string 3"

      Next i

End Sub

Upvotes: 1

Related Questions