$$Excel-Macros$$ Macro to insert additional row in previous record with new information

htariq12

New Member
Joined
Oct 16, 2009
Messages
4
Column A contains 4 digit code

Every 4 digit code has few 8 digit codes

Column B contains 8 digit Code.

For every 8-digit code there is information related to that code in columns C-N
For some codes information is stored on 2 rows and for some codes it is stored on more than 2 rows.

Is it possible to add 2 rows for every 8-digit code just before the next 8-digit code starts. These rows will contain "Import Policy Reference" from another Sheet "Sheet3"

The sample sheet can be downloaded from
http://tsi-pk.webs.com/chapter 1.xls

I have highlighted the required 2 rows i added manually in yellow
 

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

sunnyland

Well-known Member
Joined
Jan 27, 2006
Messages
912
Hello,

Have a try at this code but try on a copy of your original. And verify the sheet name is Sheet4 or change it for what it is and that the column to use as reference to insert is column 2 or B.
Before to process the code delete your 2 yellows sample lines [line 5 and 6 in your sample]

Sub tryit()
For x = Sheet4.UsedRange.Rows.Count To 3 Step -1
If Cells(x, 2) <> "" Then
Cells(x, 2).EntireRow.Insert Shift:=xlDown
Cells(x, 2).EntireRow.Insert Shift:=xlDown
Cells(x, 1) = "Import Policy Ref:"
End If
Next
End Sub
 

htariq12

New Member
Joined
Oct 16, 2009
Messages
4
Dear Sunnyland,

Thank you very very much for your help that has turned up as a bit of light in the dark.

I have tried the script and it does the trick.

I want to ask you.

1. The macro starts inserting rows from the middle of the sheet that leaves a large area of data.

2. The macro inserts rows before each code in column b instead of after each code. this is very important to organize data.

Please help@
 

sunnyland

Well-known Member
Joined
Jan 27, 2006
Messages
912
Sorry, I may have misunderstood your problem:

will this be better for inserting after:

Sub tryit()
For x = Sheet4.UsedRange.Rows.Count To 3 Step -1
If Cells(x, 2) <> "" Then
Cells(x, 2).Offset(1).EntireRow.Insert Shift:=xlDown
Cells(x, 2).Offset(1).EntireRow.Insert Shift:=xlDown
Cells(x, 1).Offset(1) = "Import Policy Ref:"
End If
Next
End Sub

For:

1. The macro starts inserting rows from the middle of the sheet that leaves a large area of data.


I am not sure I understand what you mean by number 1 above please clarify as using your sample file it works fine on my computer from beginning row to row 52
 

htariq12

New Member
Joined
Oct 16, 2009
Messages
4
Thanks once again, it has really almost solved my problem


I have uploaded the sample sheet after using macro, it can be downloaded from
http://tsi-pk.webs.com/chapter%201.xls

1.The macro does not insert rows till the last row.
2. The macro insert 2 rows, first row consists of "import Policy ref", is it
possible that the cells of second row are merged from column B to Column E. and
3. Is it possible that the merged cells lookup for information from "sheet 3" with reference to the 8-digit code.
 

sunnyland

Well-known Member
Joined
Jan 27, 2006
Messages
912
Hello again,

Try this modified code. Hope it will work this time.
I have renamed in the code and tab the name of the worksheet to the one to make it clear.
I have realised as well [sorry] that without specifying a special worksheet cells was working on the active sheet. Sheet3 does not contains all reference numbers. For my testing, in sheet3 I modify the column B to have a formula:
="Import Policy Reference " & B3
to better check if it work or not. Remove all the import row if any from the sheet you are testing.



Sub tryit()
'I have renamed the worksheet to use for trial, theone
'I renamed the tab name and the code name, so the same name is used
'I did not realise without using a specific sheet name cell....
'will act on the active sheet

For x = theone.UsedRange.Rows.Count To 3 Step -1
With theone
If .Cells(x, 2) <> "" Then
.Cells(x, 2).Offset(1).EntireRow.Insert Shift:=xlDown
.Cells(x, 2).Offset(1).EntireRow.Insert Shift:=xlDown
.Cells(x, 1).Offset(1) = "Import Policy Ref:"
.Cells(x, 2).Offset(2).Resize(, 4).Merge
.Cells(x, 2).Offset(2).Formula = "=VLOOKUP(" & .Cells(x, 2).Address & ",Sheet3!B:C,2,FALSE)"
End If
End With
Next
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,102,288
Messages
5,485,912
Members
407,523
Latest member
Talicius

This Week's Hot Topics

Top