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

[htariq12]

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

 

[sunnyland]

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]

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]

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]

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]

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