[lnkForumImage]
TotalShareware - Download Free Software

Confronta i prezzi di migliaia di prodotti.
Asp Forum
 Home | Login | Register | Search 


 

Forums >

microsoft.public.excel.programming

RE: insert 2 rows & insert data into cell

Tom Ogilvy

12/15/2006 8:42:00 PM

Sub InsertAtChange()
Dim rng As Range
Dim r As Long
Dim res As Variant
With Worksheets("Names")
Set rng = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For r = Cells(65536, "h").End(xlUp).Row To 3 Step -1
If Cells(r, "h") <> "" And _
Cells(r, "h") <> Cells(r - 1, "h") Then
Rows(r).Resize(2).EntireRow.Insert
res = Application.Match(Cells(r - 1, "h"), rng, 0)
If Not IsError(res) Then
Cells(r + 1, "B").Value = rng(res)(1, 2)
End If
End If
Next r
End Sub

is what I understood you to describe - although I would have searched using
the value in 851.

> two rows are inserted, call them ROWS 850 and 851.
the old r row is now row 852 and the row compared against is row 849 (r - 1)

Anyway, test it against a copy of your data.

--
Regards,
Tom Ogilvy




"RealGomer" wrote:

> I have a spreadsheet that has roughly 13,000 rows / records. I found this
> nifty bit of code in the General Discussion area that inserts a single row.
>
> Sub InsertAtChange()
> Dim r As Long
> For r = Cells(65536, "a").End(xlUp).Row To 3 Step -1
> If Cells(r, "a") <> "" And Cells(r, "a") <> Cells(r - 1, "a")
> Then
> Rows(r).EntireRow.Insert
> End If
> Next r
> End Sub
>
> I would like to know if it would be possible to modify or amend this code so:
> 1) Two (2) rows instead of just one were inserted, and
> 2) Data from another tab in the same notebook is inserted into a specific
> cell.
>
> To help clarify, I have two tabs in the workbook, DATA and NAMES. The DATA
> tab has columns A through H, with column H being the "sort" column. I already
> know that I need to replace "a" with "h" in the above code.
>
> When I run the code, VBA goes chugging along and where column H changes in
> value, two rows are inserted, call them ROWS 850 and 851.
> The VBA would then go to NAMES and go to the row whose value in COLUMN A
> matches the value in CELL "DATA:H849". Let's call it "NAMES:A2".
> The code would then move to CELL "NAMES:B2", copy the contents, and paste it
> into CELL "DATA:B851". The code would then repeat the process untill all 113
> names in the NAMES tab are properly inserted into the DATA tab.
>
> I hope this is clear.
>
> Oh, and I hope the solution, if there is one, is simple. I can't code worth
> a lick.
>
> Thank you.
>
> --
> I know enuff to be dangerous.
1 Answer

RealGomer

12/15/2006 10:08:00 PM

0

Thanks, Tom. I'll give it a try when I get back to work.
I thought I was getting too wordy, but here is a (poor?) sample of what I
want to do.

Tab "DATA"

Run VBA code

Row 850 XXXXX XXX XXXXX H
Inserted Row 851
Inserted Row 852 - Look-up "NAMES" Where Column A = "H"
Copy Data from NAMES: Row 1/Column B = "Mockingbird Lane"
Inserted into DATA:B852 "Mockingbird Land"
Repeat VBA Code to find next value change in Column H ect.
End at last row of DATA.
--
I know enuff to be dangerous.


"Tom Ogilvy" wrote:

> Sub InsertAtChange()
> Dim rng As Range
> Dim r As Long
> Dim res As Variant
> With Worksheets("Names")
> Set rng = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
> End With
> For r = Cells(65536, "h").End(xlUp).Row To 3 Step -1
> If Cells(r, "h") <> "" And _
> Cells(r, "h") <> Cells(r - 1, "h") Then
> Rows(r).Resize(2).EntireRow.Insert
> res = Application.Match(Cells(r - 1, "h"), rng, 0)
> If Not IsError(res) Then
> Cells(r + 1, "B").Value = rng(res)(1, 2)
> End If
> End If
> Next r
> End Sub
>
> is what I understood you to describe - although I would have searched using
> the value in 851.
>
> > two rows are inserted, call them ROWS 850 and 851.
> the old r row is now row 852 and the row compared against is row 849 (r - 1)
>
> Anyway, test it against a copy of your data.
>
> --
> Regards,
> Tom Ogilvy
>
>
>
>
> "RealGomer" wrote:
>
> > I have a spreadsheet that has roughly 13,000 rows / records. I found this
> > nifty bit of code in the General Discussion area that inserts a single row.
> >
> > Sub InsertAtChange()
> > Dim r As Long
> > For r = Cells(65536, "a").End(xlUp).Row To 3 Step -1
> > If Cells(r, "a") <> "" And Cells(r, "a") <> Cells(r - 1, "a")
> > Then
> > Rows(r).EntireRow.Insert
> > End If
> > Next r
> > End Sub
> >
> > I would like to know if it would be possible to modify or amend this code so:
> > 1) Two (2) rows instead of just one were inserted, and
> > 2) Data from another tab in the same notebook is inserted into a specific
> > cell.
> >
> > To help clarify, I have two tabs in the workbook, DATA and NAMES. The DATA
> > tab has columns A through H, with column H being the "sort" column. I already
> > know that I need to replace "a" with "h" in the above code.
> >
> > When I run the code, VBA goes chugging along and where column H changes in
> > value, two rows are inserted, call them ROWS 850 and 851.
> > The VBA would then go to NAMES and go to the row whose value in COLUMN A
> > matches the value in CELL "DATA:H849". Let's call it "NAMES:A2".
> > The code would then move to CELL "NAMES:B2", copy the contents, and paste it
> > into CELL "DATA:B851". The code would then repeat the process untill all 113
> > names in the NAMES tab are properly inserted into the DATA tab.
> >
> > I hope this is clear.
> >
> > Oh, and I hope the solution, if there is one, is simple. I can't code worth
> > a lick.
> >
> > Thank you.
> >
> > --
> > I know enuff to be dangerous.