Solved: Adding another code the original VBA code (Excel 2003)

[VNouBA]

I have the following VB Code:

[VBA]
If Not Intersect(Target, Range("B1:B100")) Is Nothing Then
For i = 1 To Target ' stops the code looping
tmpArr = tmpArr & "," & i
Next i

With Target.Offset(, 1).Resize(Target)
.NumberFormat = "000"
.Value = Application.Transpose(Split(Mid(tmpArr, 2), ","))
For i = 1 To Target
Target.Offset(i - 1, 1).Value = Target.Offset(0, -1).Value & "/" & Format(Target.Offset(i - 1, 1).Value, "000/HS")
Next i
End With
End If

End If
[/VBA]


The function is: If a number is added to Column B then “x” amount of rows is inserted with the information from Column A plus “/” and “000/HS” in Column C.

I need to add the following:

If a number is added in Column B then add “x” amount of rows with the information from Column A plus “/” and “000/HS” in Column C Then Search Column A from that same row to add the information from Column A to the extra rows but downwards from Column A.

Example if you take row 7

If Column A Row 7 text is “Report” Then the user adds “004” to Column B Row 7, the code will add three rows in column C adding the following information.

C7 = Report/001/HS; C8 = Report/002/HS; C9 = Report/003/HS; C10 = Report/004/HS.

This is the existent code.

I need the code to also Add the “Report” from Column A Row 7 to Column A Row 8,9 and 10.

Please help

[VNouBA]

Will Try to post a picture

[VNouBA]

This is what the code will do after you insert a number in coloumn B. In this example B5 = 004

[VNouBA]

I need the new code to do the following:

[Bob Phillips]

[VBA] If Not Intersect(Target, Range("B1:B100")) Is Nothing Then

For i = 1 To Target ' stops the code looping
tmpArr = tmpArr & "," & i
Next i

With Target

With .Offset(, 1).Resize(.Value)

.NumberFormat = "000"
.Value = Application.Transpose(Split(Mid(tmpArr, 2), ","))
.Formula = "=A$" & .Row & "&""/""&TEXT(ROW()-" & .Row - 1 & ",""000""""/HS"""""")"
.Value = .Value
End With

.Offset(0, -1).AutoFill .Offset(0, -1).Resize(.Value)
End With
End If
[/VBA]

[VNouBA]

My god I was waiting for this for 4 weeks and you gave it to me in less then 10 minutes...


xld I cannot thank you enough

[VNouBA]

Small glitch:

When there is numbers in Column A it drops down as 001, 002, 003.

I need to be the same as the following:

[VNouBA]

If you add numbers to the end it will do the following:


I need it to copy Project01 and to add it as Project01 not Project02, 03, 04

[VNouBA]

Changed from:

[VBA]
.Offset(0, -1).AutoFill .Offset(0, -1).Resize(.Value)
[/VBA]

To:
[VBA]
.Offset(0, -1).Copy .Offset(0, -1).Resize(.Value)
[/VBA]

[Bob Phillips]

I take it you have sorted it. Correct?

[VNouBA]

Yes thank you very much for your help