Incrementing a Variable in For-loop in Vba? - excel

Question

# This is the input table for which I want to perform some action #
Public Sub mac()
Dim RangeOfChild As Range
For i = 1 To 10000
ActiveCell.Range("A" & i).Activate
Dim DirArray As Variant
Dim temp As Variant
Set RangeOfChild = Range(ActiveCell.Offset(0, 1),ActiveCell.End(xlToRight))
childCount = RangeOfChild.count
temp = ActiveCell.Value
ActiveCell = Null
DirArray = RangeOfChild.Value
RangeOfChild.ClearContents
ActiveCell.EntireRow.Resize(childCount - 1).Insert Shift:=xlDown
ActiveCell.Value = temp
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(RangeOfChild.count - 1, 1)) = Application.Transpose(Array(DirArray))
i = i + (childCount)
Next i
End Sub
I want a output similar to the below image
enter image description here
But the written for loop is only doing the operation to two of the rows , not the remaining, If someone could help me out with this , it would be a great help.

Answer 1

I accomplished this task by using two worksheets: worksheets("SheetInput") which contains the input data and worksheets("SheetOutput") which receives the formatted output.
Option Explicit
Public Sub mac()
Dim wsData As Worksheet, wsOutput As Worksheet
Dim rngInput As Range, RangeOfChild As Range, rngOutput As Range
Dim childCount As Long
Set wsData = ThisWorkbook.Worksheets("SheetInput")
Set wsOutput = ThisWorkbook.Worksheets("SheetOutput")
Set rngInput = ThisWorkbook.Worksheets("SheetInput").Cells(1, 1)
Set rngOutput = ThisWorkbook.Worksheets("SheetOutput").Cells(1, 1)
While Not (IsEmpty(rngInput))
Set RangeOfChild = Range(rngInput.Offset(0, 1), rngInput.End(xlToRight))
childCount = RangeOfChild.Count
rngInput.Copy
rngOutput.PasteSpecial Paste:=xlPasteAll
RangeOfChild.Copy
rngOutput.Offset(0, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
Set rngInput = rngInput.Offset(1, 0)
Set rngOutput = rngOutput.Offset(childCount, 0)
Wend
End Sub

Answer 2

activate method is not good. use a variant array.
Sub test()
Dim rngDB As Range, rngCnt As Range
Dim rng As Range, rng2 As Range
Dim vCnt, vR()
Dim i As Integer, c As Integer, n As Long, s As Long
Set rngDB = Range("a1", Range("a" & Rows.Count).End(xlUp))
For Each rng In rngDB
Set rngCnt = Range(rng.Offset(, 1), rng.End(xlToRight))
s = n + 1
vCnt = rngCnt
c = rngCnt.Columns.Count
n = n + c
ReDim Preserve vR(1 To 2, 1 To n)
vR(1, s) = rng
For i = 1 To c
vR(2, s + i - 1) = vCnt(1, i)
Next i
Next rng
Sheets.Add
Range("a1").Resize(n, 2) = WorksheetFunction.Transpose(vR)
End Sub