Copy a and paste a range based on active cell location

[Rodger]

Hi All !

Im baffled, so I am turning to the gurus.

I am looping through cells D1:D250. When there is a non-blank cell, I wish to copy from that row down, columns D to K, and paste it down one row, in the same columns.
In essence, creating a blank row above it.

**The idea is to create a space between Categories in the attached sample form.

Unless there is a better way to move the data down?

Any help is much appreciated!

Rodger

I should note that I am fine with inserting the code in my VBA, if I could just figure out what it could possibly be!

 

[Hui]

try this:

Sub InsertBlankRow()
Dim x As Integer
Worksheets("Inventory").Activate
For x = 250 To 7 Step -1
If Cells(x, 4).Text <> "" Then Range(Cells(x, 4), Cells(x, 12)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next x

End Sub

 

[Rodger]

Hui, thanks for taking a look!

This works great (here comes the dreaded 'except")
Except I didnt think to mention that the other columns have formulas, and this is clearing them out.

Rodger

 

[Hui]

Try this modified code

Sub InsertBlankRow()
Dim x As Integer
Const lr As Integer = 250 'Last row
Worksheets("Inventory").Activate
Application.EnableEvents = False
'Insert Blank Rows
For x = lr To 8 Step -1
  If Cells(x, 4).Text <> "" Then Range(Cells(x, 4), Cells(x, 12)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next x

'Reset Formulas
Range("H7").Copy Range("H8:H" + cstr(lr))
Application.CutCopyMode = False

Application.EnableEvents = False

End Sub

 

[Rodger]

Thats great Hui !

Thanks again for your time.

Cheers

 

[Marc L]

Hi !

Before the procedure ends, EnableEvents must be set to True …

Rodger, check formulas & results in column H after creating the blank rows.

Because of your worksheet design, maybe better is to not insert
any blank row but to skip a row when creating a new item …

Or creating blanks like this (paste code to worksheet module) :​

Sub Demo1()
      Dim R&
      Application.EnableEvents = False
      Application.ScreenUpdating = False
With Me.UsedRange.Columns(4)
          R = .Find("*", , xlValues, xlWhole, , xlPrevious).Row
    While R > 7
       If Cells(R - 1, 7).Value > "" Then .Cells(R).EntireRow.Insert
          R = .FindPrevious(.Cells(R)).Row
    Wend
End With
      Application.EnableEvents = True
      Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Rodger]

Hi Marc
Thanks for the input! It will be the user entering the data, and I'd like it foolproof in case they dont skip a row when entering, and for other portions of the program, there needs to be a space between categories.

I will take a look at your code when I get home later.

Much appreciated!

Rodger