Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to copy previous row and insert two blank rows
Hi,
I'm working on a excel sheet that contains about 6000 rows of data. What I need to do is to look at column A and go through the rows and whenever the row has the text "Total Spend" I need to copy it to the following row with "Total N Spend" and insert two blank rows after that. So for example: Column A Row 1 Apple Row 2 IBM Row 3 Dell Row 4 Total Spend - Computer Row 5 (Would copy row 4) Total N Spend - Computer Row 6 Insert Blank Row Row 7 Insert Blank Row Row8 CarA Row9 CarB Row10 Total Spend - Cars Row11 Total N Spend - Cars Row12 Insert Blank Row etc. Previously someone helped me with this code below but nothing happens after I run this macro. Any help is appreciated, Thank you. Sub TotalSpend() Dim iCount As Integer Dim iMax As Integer Dim iLength As Integer iCount = 1 iMax = WorksheetFunction.CountA(Sheets("Sheet1").Columns( 1)) Do Until Left(Sheets("Sheet1").Cells(iCount, 1).Value, 11) = "Total Spend -" iCount = iCount + 1 Select Case iCount Case Is iMax MsgBox "Some data must be missing in Column A of Sheet1." Exit Sub End Select Loop iLength = Len(Sheets("Sheet1").Cells(iCount, 1).Value) Sheets("Sheet1").Cells(iCount + 1, 1).Value = "Total N Spend - " & _ Right(Sheets("Sheet1").Cells(iCount, 1).Value, iLength - 14) End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to copy previous row and insert two blank rows
Try this modified macro on a copy of your workbook
Sub TotalSpendSub() Dim myRange As Range Dim r As Range Dim InsertVal As Boolean Set myRange = Sheets("Sheet1").Cells(1, 1) lrow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row Set myRange = myRange.Resize(lrow, 1) InsertVal = True For Each r In myRange Debug.Print r.Value If Len(r.Value) 0 Then If r.Value Like "Total*" Then If InsertVal Then InsertVal = False r.Offset(1, 0).EntireRow.Insert r.Offset(1, 0).EntireRow.Value = r.EntireRow.Value r.Offset(2, 0).EntireRow.Insert r.Offset(3, 0).EntireRow.Insert Else InsertVal = True End If End If End If Next r End Sub "dd" wrote: Hi, I'm working on a excel sheet that contains about 6000 rows of data. What I need to do is to look at column A and go through the rows and whenever the row has the text "Total Spend" I need to copy it to the following row with "Total N Spend" and insert two blank rows after that. So for example: Column A Row 1 Apple Row 2 IBM Row 3 Dell Row 4 Total Spend - Computer Row 5 (Would copy row 4) Total N Spend - Computer Row 6 Insert Blank Row Row 7 Insert Blank Row Row8 CarA Row9 CarB Row10 Total Spend - Cars Row11 Total N Spend - Cars Row12 Insert Blank Row etc. Previously someone helped me with this code below but nothing happens after I run this macro. Any help is appreciated, Thank you. Sub TotalSpend() Dim iCount As Integer Dim iMax As Integer Dim iLength As Integer iCount = 1 iMax = WorksheetFunction.CountA(Sheets("Sheet1").Columns( 1)) Do Until Left(Sheets("Sheet1").Cells(iCount, 1).Value, 11) = "Total Spend -" iCount = iCount + 1 Select Case iCount Case Is iMax MsgBox "Some data must be missing in Column A of Sheet1." Exit Sub End Select Loop iLength = Len(Sheets("Sheet1").Cells(iCount, 1).Value) Sheets("Sheet1").Cells(iCount + 1, 1).Value = "Total N Spend - " & _ Right(Sheets("Sheet1").Cells(iCount, 1).Value, iLength - 14) End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
macro to insert row and copy previous row + excel | Excel Discussion (Misc queries) | |||
Macro to copy previous row and insert two blank rows | Excel Discussion (Misc queries) | |||
Need macro to check if cell is not blank & previous cell is blank, copy information from row above & paste | Excel Programming | |||
Macro to insert copy and insert formulas only to next blank row | Excel Programming | |||
Activate a macro to insert a row and copy the formuals from the rows above to the blank row | Excel Discussion (Misc queries) |