VBA script to put text in every 20th cell

[Magoosball]

I have a workbook that is thousands of rows long. I am looking for a VBA script that will put an "X" into every 20th cell in column E. The first row is a header so this means that I need to add an X into column E on rows 21, 41, 61, 81 101 and so on.

After that I need to cut ever Row that has an "X" in column E and place it at the top of the worksheet underneath the header row. So this is pasting them starting at row 2. Also need to color the entire row that has an X in it with the color yellow.


Thank you in advance!

 

[My Aswer Is This]

So how do we know when to stop. You said thousands of rows.

Can we stop when we find no data in column "A"

 

[Rick Rothstein]

After that I need to cut ever Row that has an "X" in column E and place it at the top of the worksheet underneath the header row. So this is pasting them starting at row 2. Also need to color the entire row that has an X in it with the color yellow.

Does this mean you are overwriting the existing cells in Rows 2, 3, 4, etc. with every 20th row of data? If so, what should happen to the rows of existing data underneath the last pasted row of data... leave them or delete them?

 

[Magoosball]

Does this mean you are overwriting the existing cells in Rows 2, 3, 4, etc. with every 20th row of data? If so, what should happen to the rows of existing data underneath the last pasted row of data... leave them or delete them?

Overwriting no. Just inserting them and moving the existing rows down.

 

[Magoosball]

So how do we know when to stop. You said thousands of rows.

Can we stop when we find no data in column "A"

Should have clarified this. Yes you can stop when there is no data in column A

 

[Rick Rothstein]

Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub RetrieveEvery20thRow()
  Dim LastRow As Long, Xcount As Long
  If ActiveSheet.FilterMode Then Range("E:E").AutoFilter
  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious, , , False).Row
  Range("E2:E" & LastRow) = Evaluate(Replace("IF(MOD(ROW(E2:E#)-1,20)=0,""X"",IF(E2:E#="""","""",E2:E#))", "#", LastRow))
  Xcount = [COUNTIF(E:E,"X")]
  Rows(2).Resize(Xcount).Insert
  Range("E:E").AutoFilter Field:=1, Criteria1:="X"
  Range("E2:E" & LastRow + Xcount).SpecialCells(xlVisible).EntireRow.Copy Range("A2")
  Range("E:E").AutoFilter
  Intersect(Rows("2:" & 1 + Xcount), ActiveSheet.UsedRange).Interior.Color = vbYellow
End Sub[/td]
[/tr]
[/table]

 

[Magoosball]

Thank you! This worked