column a: loop thru column range a1:a100 and copy/paste into other col in sheet at change in value

[MikeL]

Hi,
Column A has a list of fruit.

A1: orange
A2: orange
A3: orange
A4: kiwi
A5: kiwi
A6: blueberry

Requesting VBA to loop thru column A. Then Copy value to cell B1 until value changes. Then cell C1 etc.


in example, result is:
col b has b1 thru b3 with orange, col c has c1 thru c2 with kiwi and d1 has blueberry.

Thanks

 

[offthelip]

try this code:

Sub test()
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(lastrow, 1))
outarr = Range(Cells(1, 2), Cells(lastrow, lastrow))
fruit = inarr(1, 1)
ri = 1
ci = 1
For i = 1 To lastrow
 If inarr(i, 1) = fruit Then
  outarr(ri, ci) = inarr(i, 1)
  ri = ri + 1
 Else
   fruit = inarr(i, 1)
   ri = 1
   ci = ci + 1
   outarr(ri, ci) = inarr(i, 1)
   ri = ri + 1
 End If
Next i
Range(Cells(1, 2), Cells(lastrow, lastrow)) = outarr


End Sub

 

[MikeL]

thank you!

 

[MikeL]

Hello, I am starting to get an error 1004 when applying this to a larger dataset. ie 1Million rows. also my change in 'fruit' is now in Col B not A. the outarr gives the error


Sub test()
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(lastrow, 1))
outarr = Range(Cells(1, 2), Cells(lastrow, lastrow))
fruit = inarr(1, 1)
ri = 1
ci = 1
For i = 1 To lastrow
If inarr(i, 1) = fruit Then
outarr(ri, ci) = inarr(i, 1)
ri = ri + 1
Else
fruit = inarr(i, 1)
ri = 1
ci = ci + 1
outarr(ri, ci) = inarr(i, 1)
ri = ri + 1
End If
Next i
Range(Cells(1, 2), Cells(lastrow, lastrow)) = outarr


End Sub

 

[offthelip]

The error mighht be caused by trying to declare an aray that is 1 million by 1 million is size.
If you know how many different fruits there are , you only need to declare the same number of columns as you have fruits.
Try this code where you can specify the number of fruits by changing the value in Nfruits

Sub test()
Nfruits= 100
lastrow = Cells(Rows.Count, "B").End(xlUp).Row
inarr = Range(Cells(1, 2), Cells(lastrow, 2))
outarr = Range(Cells(1, 3), Cells(lastrow, Nfruits+2))
fruit = inarr(1, 1)
ri = 1
ci = 1
For i = 1 To lastrow
If inarr(i, 1) = fruit Then
outarr(ri, ci) = inarr(i, 1)
ri = ri + 1
Else
fruit = inarr(i, 1)
ri = 1
ci = ci + 1
outarr(ri, ci) = inarr(i, 1)
ri = ri + 1
End If
Next i
Range(Cells(1, 3), Cells(lastrow, Nfruits+2)) = outarr




End Sub

I made some changes to pick the fruiut list from column B too