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

MikeL

Active Member
Joined
Mar 17, 2002
Messages
488
Office Version
  1. 365
Platform
  1. Windows
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
 
Last edited:

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
try this code:
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
 
Upvote 0
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
 
Upvote 0
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
Code:
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
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,564
Messages
6,114,334
Members
448,567
Latest member
Kuldeep90

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top