Inserting Rows ....

[excel_newbie_2]

Hello everyone

I was wondering if you could help me.. I am a beginner and need some help with the code I have just written. I need to alter this code in order to do 2 things

1. to leave a blank line inbwteen Shop A's Apples, Shop A's Pears etc
2. I also wanted to total up the price totals....(see example below).So if the last price was in E4, the total of all those prices above would show in F5

SHOP A STAT 1 STAT 2 APPLES 2.30
SHOP A STAT 1 STAT 2 APPLES 2.30
4.60
SHOP A STAT 1 STAT 2 PEARS 3.40
SHOP A STAT 1 STAT 2 PEARS 4.10
7.50


This is the code I need to alter for the blank lines and totals (i've only included the code for SHOP A)-

Sub Macro1()
Application.ScreenUpdating = False
Sheets("Data").Select
Lastrow = Range("A65536").End(xlUp).Row

For i = 1 To Lastrow
Sheets("Data").Select

If Cells(i, 1) = "SHOP A" _
And Cells(i, 4) = "APPLES" Then
Rows(i & ":" & i).Select
Selection.Copy
Sheets("Sheet3").Select
PasteRow = Range("F65536").End(xlUp).Offset(1, 0).Row
Rows(PasteRow & ":" & PasteRow).Select
Selection.Insert Shift:=xlDown
End If

Next i

Range("A1").Select
Application.ScreenUpdating = True
Application.ScreenUpdating = False
Sheets("Data").Select
Lastrow = Range("A65536").End(xlUp).Row

For i = 1 To Lastrow
Sheets("Data").Select

If Cells(i, 1) = "SHOP A" _
And Cells(i, 4) = "PEARS" Then
Rows(i & ":" & i).Select
Selection.Copy
Sheets("Sheet3").Select
PasteRow = Range("F65536").End(xlUp).Offset(1, 0).Row
Rows(PasteRow & ":" & PasteRow).Select
Selection.Insert Shift:=xlDown
End If

Next i

Range("A1").Select
Application.ScreenUpdating = True
End Sub

 

[Domski]

Amended code to put two rows in:

Sub insert_rows()
Dim lastRow As Long, myRow As Long
'   Find last populated row in column A
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
'   Loop through from last row to row 3
For myRow = lastRow To 3 Step -1
'   Check is items in column A or D are different to the one above
If Cells(myRow, 1) <> Cells(myRow - 1, 1) Or Cells(myRow, 4) <> Cells(myRow - 1, 4) Then
'   Insert rows if so
Rows(myRow & ":" & myRow + 1).Insert
End If
'   Loop up to next row
Next myRow
End Sub
 
Sub insert_totals()
Dim lastRow As Long, myRow As Long, startRow As Long
'   Find row below last item in column A
lastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
'   Set row at top of first block of data
startRow = 2
'   Loop through rows
For myRow = startRow To lastRow
    
'   Check if cell in column A is blank and cell above isn't
    If Cells(myRow, 1) = "" And Cells(myRow - 1, 1) <> "" Then
 
'   Insert sum formula
        Cells(myRow, 5).Formula = "=SUM(E" & startRow & ":E" & myRow - 1 & ")"
'   Set start of next block
        startRow = myRow + 2
 
    End If
 
'   Loop to next row
Next myRow
End Sub

Dom

 

[excel_newbie_2]

Thanks DOm that would be super helpful

 

[excel_newbie_2]

Hey Dom, any thoughts on how I can insert 2 lines instead of just the one ? Cheers for all the help so far, Isha

 

[excel_newbie_2]

Hi Dom, <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
Thanks for the amended code - I only saw it just now !! Have tried it out with the data set and it works a treat.
<o></o>
I now have an expanded data set now . There are more columns - A to M. Shop is still in column A, product is in F and I want column M summed. I have adjusted the code (in pink) so it now looks like below, however it now doesnt work. When I run it, the screen just flashes the when I look at the code, the 'END IF' part in the first sub is highlighted in yellow. Is there something else I need to amend?

Thanks so much in advance DOM !!!!!

<o></o>
Sub insert_rows()
Dim lastRow As Long, myRow As Long
' Find last populated row in column A
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through from last row to row 3
For myRow = lastRow To 3 Step -1
' Check is items in column A or F are different to the one above
If Cells(myRow, 1) <> Cells(myRow - 1, 1) Or Cells(myRow, 6) <> Cells(myRow - 1, 6) Then
' Insert rows if so
Rows(myRow & ":" & myRow + 1).Insert
End If
' Loop up to next row
Next myRow
End Sub

Sub insert_totals()
Dim lastRow As Long, myRow As Long, startRow As Long
' Find row below last item in column A
lastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
' Set row at top of first block of data
startRow = 2
' Loop through rows
For myRow = startRow To lastRow

' Check if cell in column A is blank and cell above isn't
If Cells(myRow, 1) = "" And Cells(myRow - 1, 1) <> "" Then

' Insert sum formula
Cells(myRow, 13).Formula = "=SUM(M" & startRow & ":M" & myRow - 1 & ")"
' Set start of next block
startRow = myRow + 1

End If

' Loop to next row
Next myRow
End Sub<o></o>
<o></o>

 

[Domski]

Looks fine to me. If the row is just highlighted in yellow but you haven't got an error it sounds like the code has just been stopped there. You can click the Continue button on the toolbar to resume the code.

If you're posting code it's best to surround it with code tags. You can do this by just typing [ code] and [ /code] (without the spaces after the [)around the code you are posting or clicking the # button in advanced mode while you've got the code highlighted. Just makes it a lot easier to read.

Let us know how you get on.

Dom