Solved: Trouble with Inserting Rows

[kiyiya]

I am trying to dynamically add rows above the cell that contains the text "Insert New Row" but have not been successful. What I am doing is transferring data from one sheet to another only if a cell value is True. My loop works perfectly for that part ,however, I now have a need to extend the cell range I orginally used but only if I "need" to.

My code is:
Sub copy_to()
Sheet6.Range("A14:D60").ClearContents
For i = 10 To 100
If Sheet1.Cells(i, 3) = "True" Then
For x = 14 To 60
If Sheet6.Cells(x, 1) = "Insert New Row" Then
Sheet6.Cells(x, 1).EntireRow.Insert xlShiftDown
Else
If Sheet6.Cells(x, 1) = "" Then
Sheet6.Cells(x, 1) = Sheet1.Cells(i, 6)
Sheet6.Cells(x, 2) = Sheet1.Cells(i, 7)
Sheet6.Cells(x, 3) = Sheet1.Cells(i, 8)
Sheet6.Cells(x, 4) = Sheet1.Cells(i, 9)
GoTo 1
End If
End If
Next x
End If
1 Next i

Any suggestions?

[mdmackillop]

Try

For x = 60 To 14 Step -1


If that doesn't work, can you post a sample of your workbook to show what should happen?

[kiyiya]

Try

For x = 60 To 14 Step -1


If that doesn't work, can you post a sample of your workbook to show what should happen?

That clears everything.

Stupid me....... I was clearing the contents of the cell I had the "Insert New Row" text in. Corrected that and now I get 30 new rows added.

Corrected code:
Sub copy_to_receipt()
Sheet6.Range("A14:D60").ClearContents
Sheet6.Range("A31") = "Insert New Row"
For i = 10 To 100
If Sheet1.Cells(i, 3) = "True" Then
For x = 14 To 60
If Sheet6.Cells(x, 1) = "Insert New Row" Then
Sheet6.Cells(x, 1).EntireRow.Insert xlShiftDown
Else
If Sheet6.Cells(x, 1) = "" Then
Sheet6.Cells(x, 1) = Sheet1.Cells(i, 6)
Sheet6.Cells(x, 2) = Sheet1.Cells(i, 7)
Sheet6.Cells(x, 3) = Sheet1.Cells(i, 8)
Sheet6.Cells(x, 4) = Sheet1.Cells(i, 9)
GoTo 1
End If
End If
Next x
End If
1 Next i

End Sub

So now it works but it adds way too many rows. How do I stop that behavior?

[f2e4]

Rather than doing a loop, you could use the find function:

This might / might not speed things up for you....


Dim x As Integer
x = Columns(1).Find("Insert New Row", after:=Cells(13, 1)).Row

With Cells(x, 3)
If .Value = "Insert New Row" Then
.EntireRow.Insert xlShiftDown
End If
End With

[kiyiya]

Figured it out:

Sub copy_to_receipt()
Sheet6.Range("A14:D60").ClearContents
Sheet6.Range("A31") = "Insert New Row"
For i = 10 To 100
If Sheet1.Cells(i, 3) = "True" Then
For x = 14 To 60
If Sheet6.Cells(x, 1) = "Insert New Row" Then
Sheet6.Cells(x, 1).EntireRow.Insert xlShiftDown
GoTo 2
Else
2 If Sheet6.Cells(x, 1) = "" Then
Sheet6.Cells(x, 1) = Sheet1.Cells(i, 6)
Sheet6.Cells(x, 2) = Sheet1.Cells(i, 7)
Sheet6.Cells(x, 3) = Sheet1.Cells(i, 8)
Sheet6.Cells(x, 4) = Sheet1.Cells(i, 9)
GoTo 1
End If
End If
Next x
End If
1 Next i
Sheet6.Activate

[kiyiya]

Sample workbook for the solution if anyone is interested.

[kiyiya]

Rather than doing a loop, you could use the find function:

This might / might not speed things up for you....


Dim x As Integer
x = Columns(1).Find("Insert New Row", after:=Cells(13, 1)).Row

With Cells(x, 3)
If .Value = "Insert New Row" Then
.EntireRow.Insert xlShiftDown
End If
End With


Interesting approach. I will add this to my "library". Thanks.

[kiyiya]

Dim x As Integer
x = Columns(1).Find("Insert New Row", after:=Cells(13, 1)).Row

With Cells(x, 3)
If .Value = "Insert New Row" Then
.EntireRow.Insert xlShiftDown
End If
End With


f2e4,

I am getting an error when I run this code. It states "object variable or with block variable not set".
I keep breaking it.

[mdmackillop]

The code will error as shown if the search string is not found.
The code will also error if the row returned is greater than 32767, the limit for Integer data type. x should be dimmed as long
Also consider the LookAt setting for the Find method. Is it correct?

Best solution is to return the range

Sub test()
Dim x As Range
Set c = Columns(1).Find("Insert New Row", after:=Cells(13, 1))
If Not c Is Nothing Then c.EntireRow.Insert
End Sub

[kiyiya]

Best solution is to return the range

Sub test()
Dim x As Range
Set c = Columns(1).Find("Insert New Row", after:=Cells(13, 1))
If Not c Is Nothing Then c.EntireRow.Insert
End Sub



"The code will error as shown if the search string is not found." That fixed one error.

Did you mean Dim c as Range? When I run the code c is always =nothing so a row is never inserted even though the criteria is met with the text Insert New Row existing on row 14.

[mdmackillop]

Can you post a sample of your workbook?

[kiyiya]

Here you go. The first button is a working solution with my loops the second button is not working correctly. I need the "Inser New Row" to drop down each time like the first button does it. I also added a delete button on the second page that works but could be better I think.

Thanks for looking at this.

[mdmackillop]

Hi kiyiya.
To be honest, inserting rows is not the way to go about this problem. From what I can see, you want to check range for True values and copy corresponding cells to another sheet. (I'm not clear if this is to overwrite existing data) At the end of that data, you want the text Insert New Row (for some purpose). Is that correct?

[kiyiya]

Hi kiyiya.
To be honest, inserting rows is not the way to go about this problem. From what I can see, you want to check range for True values and copy corresponding cells to another sheet. (I'm not clear if this is to overwrite existing data) At the end of that data, you want the text Insert New Row (for some purpose). Is that correct?

Correct. This is for a receipt and there are a limited number of rows that can be written to before it interferes with other data on the receipt. My solution was to not allow data to overwrite existing data below the allotted rows by inserting new rows. This, to me, seems like the best solution as it will not write to areas of the receipt that contains permanent data.

My process (in my mind anyway) is to bring everything from the first sheet in the order that it is checked by checkboxes (TRUE cells) over to the second sheet without running out of room. I originally allowed 20 items to be added to the sheet to keep it at a full page but have found that additional rows are needed at times to accomodate special circumstances.

Adding those additional rows statically pushes the receipt to a second page even a single item was purchased which is not acceptable.

I do need to clear all items added to the receipt because there is a button that allows the user to go back and update the receipt as it moves through the business from check in to pay out. As long as a user adds to the receipt there would be no problem, however, when there is a need to remove items I needed to include code to accomodate that. This is the reason I must remove all data coming from the first sheet to the second sheet including any additional rows that may have been added. What I ran into was way too many additional rows staying when the receipt was redone when they should have been removed.

Hope that clears it up a bit.

Do you have another suggestion as to how I should approach this?

[kiyiya]

mdmackillop ,

One other thing.......... The text "Insert New Row" is just something I am using as a marker to figure out where to add and remove rows in the sample workbook. On the receipt I will use staic data such as "Total" and not "Insert New Row". I missed that on your previous response and I see the confusion: my apologies.

[mdmackillop]

Try this version

[kiyiya]

Excellent! Far as I can tell the end result is the same but in faster time. Now I am going to have to research the code so I will be able to understand it.

Thank you for your help and for commenting the code!

[mdmackillop]

With a few rows, looping is fine, but reduce actions in the loop as far as possible. The Filter avoids the need to loop, and will work almost as quickly on 1000 rows as 100. Looping 1000 rows gets very slow. Similarly, use FindNext to find succesive ocurrences, rather than check evey cell for occasional values.

[kiyiya]

Thanks for the lesson. I now need to get this code into the real project to see how fast it really is.

Kiyiya

[kiyiya]

Hello,

I hate to drag this out again but I have another request to better the process.

The attached workbook shows working code that transfers data over to another sheet and inserts a new row above where it encounters the string "Insert New Row". That works beautifully with the exceotion of one thing: the formatting from the rows above it is not being brought down with the new row.

I would like to be able to have whatever formatting is included in the blank row above the "Insert New Row" string location to be included in that process.

MD can you help?

[mdmackillop]

'Apply format
Tgt.Resize(, 4).Copy
Tgt.Offset(1).Resize(Rw - 1, 4).PasteSpecial xlPasteFormats

Sheets("Sheet6").Activate
End Sub

[mdmackillop]

'Apply format
Tgt.Resize(, 4).Copy
Tgt.Resize(Rw, 4).PasteSpecial xlPasteFormats

Sheets("Sheet6").Activate
Range("A1").select
End Sub

[kiyiya]

Works perfectly on the sample book............ not so well on my actual book so I will try to figure out what is going on with it.

Thanks so much for your help MD!