Search value and insert row under value

[danovkos]

hi all,
i posted this in other forum, but there nobody helps me:
in in links:
http://www.excelforum.com/excel-prog...ml#post2070455

can you help me with this?
i search a macro which will do following.

I have a range of cells (old data) and other range of data (new data - those are locatet under the old data). I want after i select my new range of data (only yellow data) and running macro look in to the old data (blue) where can by blank row too and looking for the same id (id_new=id). If it found any, it will insert row under the last equal ID value (in old, yellow data) and copy the new data (whole row) in the created row in new data (blue)
Here is atach. with 2 sheet. Sheets with name "Before" and "after".

I want to use it for a huge data (about 6000 rows and 80 columns)
The range of old data will be always ends 5 rows upper the new data
Please how can i do this?

[MaximS]

try my solution, see attached for details:

[danovkos]

waauu
fantastic...
thank you very very much

pls. only last question
I will try it customize for my data to column C and D but this will not works
what is wrong pls. ?

Dim ORow, NRow, x, y As Long
Dim rng As Range
With Sheets("Before")
    NRow = .Range("C65536").End(xlUp).Row
    ORow = .Range("C" & NRow).End(xlUp).Row - 6
    x = ORow + 7
    y = NRow
        
    For i = ORow To 2 Step -1
        Set rng = .Range("C" & x & ":C" & y)
        temp = Cells(i, 1).Value
        If temp <> Cells(i + 1, 1).Value And temp <> "" Then
            On Error Resume Next
            check = WorksheetFunction.Match(temp, rng, 0)
            On Error GoTo 0
            If check <> "" Then
                If Cells(i + 1, 1).Value = "" Then
                    .Range("C" & i + 1 & ":D" & i + 1).Value = _
                    .Range("C" & x - 1 + check & ":D" & x - 1 + check).Value
                    check = ""
                Else
                    .Rows(i + 1).Insert
                    .Range("C" & i + 1 & ":D" & i + 1).Value = _
                    .Range("C" & x + check & ":D" & x + check).Value
                    check = ""
                    x = x + 1
                    y = y + 1
                End If
            End If
        End If
    Next i
End With
End Sub

[danovkos]

and pls. one question,
how can i insert more as one row. F.e. If i have in new data 2 or more rows with the same ID, (there is more rows in new data with the same ID1 but the ID2 are diferent and all will be inserted). So it will insert more rows. Can it possible?
thx a lot

[danovkos]

HI all,
i tried it change, that it will works for column C and D, but something is wrong. And the really last condition what will really help me is insert more as one row if is neccessary. As is in atach.
Pls. can you help me?
thx a lot.

[MaximS]

that should be more understandable and easier for adjustment:

 
Dim ORow, NRow, x, y As Long
Dim rng As Range
With Sheets("Before")
    NRow = .Range("C65536").End(xlUp).Row
    ORow = .Range("C" & NRow).End(xlUp).Row - 6
    x = ORow + 7
    y = NRow
 
    For i = ORow To 2 Step -1
        Set rng = .Range("C" & x & ":C" & y)
        temp = .Range("C" & i).Value
        If temp <> .Range("C" & i + 1).Value And temp <> "" Then
            On Error Resume Next
            check = WorksheetFunction.Match(temp, rng, 0)
            On Error GoTo 0
            If check <> "" Then
                If .Range("C" & i + 1).Value = "" Then
                    .Range("C" & i + 1 & ":D" & i + 1).Value = _
                    .Range("C" & x - 1 + check & ":D" & x - 1 + check).Value
                    check = ""
                Else
                    .Rows(i + 1).Insert
                    .Range("C" & i + 1 & ":D" & i + 1).Value = _
                    .Range("C" & x + check & ":D" & x + check).Value
                    check = ""
                    x = x + 1
                    y = y + 1
                End If
            End If
        End If
    Next i
End With
End Sub

[MaximS]

i have reviewed my code and this should work better:

 
Private Sub Updater()
Dim TLRow, BLRow, x, y, z As Long
Dim rng, rng1 As Range
With Sheets("before")
    BLRow = .Range("C65536").End(xlUp).Row
    TLRow = .Range("C" & BLRow).End(xlUp).Row - 6
    x = TLRow + 7
    y = BLRow
    z = TLRow
    .Range("IV2:IV" & BLRow).Formula = "=C2&"" ""&D2"
    c = x
    Do Until c > y
        Set rng = .Range("C1:C" & z)
        Set rng1 = .Range("IV1:IV" & z)
        On Error Resume Next
        k = WorksheetFunction.Match(.Range("C" & c).Value, rng, 0)
        m = WorksheetFunction.Match(.Range("IV" & c).Value, rng1, 0)
        On Error GoTo 0
        If k <> "" Then
            If m = "" Then
                Do Until n <> p
                    n = .Range("C" & k).Value
                    On Error Resume Next
                    p = CInt(Left(.Range("IV" & c).Value, Len(n)))
                    On Error GoTo 0
                    k = k + 1
                Loop
                k = k - 1
                If .Range("C" & k).Value = "" And k < z Then
                    .Range("C" & k & ":D" & k).Value = _
                    .Range("C" & c & ":D" & c).Value
                Else
                    .Rows(k).Insert
                    c = c + 1
                    .Range("C" & k & ":D" & k).Value = _
                    .Range("C" & c & ":D" & c).Value
                    x = x + 1
                    y = y + 1
                    z = z + 1
                End If
            End If
        Else
            z = z + 1
            If .Range("C" & z).Value = " " Or _
                .Range("C" & z).Value = "" Then
                .Rows(z).Insert
                c = c + 1
                .Range("C" & z & ":D" & z).Value = _
                .Range("C" & c & ":D" & c).Value
                x = x + 1
                y = y + 1
            End If
        End If
        c = c + 1
        k = ""
        m = ""
        n = ""
        p = ""
    Loop
    .Columns("IV").ClearContents
End With
End Sub

[danovkos]

Yes, this works good, only one last thing. I need the new inserted rows at the end of group of IDs. Now it insert at the start. If can we this change it will be perfect.

Thank you for your big help.

[MaximS]

Can you explain what do you mean by 'end of group of IDs' ?

If possible attach sample (before/after).

[danovkos]

Is it exactly as it was in my last atach. „testx2“
But the new code insert the new data (rows) not below the data with the same ID, but at the start.

F.e. in the atach. in new data is ID new 7 and ID2 new is 777 and second value is ID NEW 7 and second value 778.
I want insert those two rows after ID 7 and ID2 79 – because this is the last row from grup with ID 7.

I hope i am cleary, because i know, that my english is bad .
but thx for you patience

[MaximS]

try now:

[danovkos]

i dont know if the sorting can help.
My data as i wrote are huge and there i can not sort because it will mix my data. Your last code works only for the example atach, but if i insert there data, which are in my DB, it will not alway work. Look at atach. this is as my data looks.

[MaximS]

try again:

[mdmackillop]

Hi Maxim,
A couple of comments on your code.
Always use Option Explicit. You have a few undeclared variables
You should Dim each variable separately Dim x, y as Long, only Dims Y as long, X is a variant. "" is not the same as 0, and cannot be assigned to a Long variable.
Try

 
Option Explicit
Private Sub Updater()
Dim TLRow, BLRow, x As Long, y As Long, z As Long
Dim rng As Range, rng1 As Range
x = 3
y = 4
z = 5
x = 0
y = "" 'Code fails here.
z = ""
End Sub

[MaximS]

hi mdmackilop,

I am always using Option Explicit and variable declarations bearing in mind their type, but at this time i've tried to give an answer as quick as possible while doing 2 projects (one for work and this for pleasure).

Thats why some of the variables are having declaration missing.

Anyway what you saying is perfectly right.

[danovkos]

Sorry guys, but it doesnt works for my huge DB. In file it works good, but if i try it in my DB it will insert new rows in the begining of IDs group (not under the data with the same ID1). I would like to send you my DB but this is secret data about of 6000 rows and 90 columns.
Can you figured out, where the probleme is without my DB?

[MaximS]

What do you mean by DB? Proper database or spreadsheet??

If it is Excel spreadsheet make a copy of it and then overwrite with random data everything except the part you willing to process i.e columns C and D.

[danovkos]

yes it is excel workbook. But the data i can not send it here because it are account number and clients IDs

[MaximS]

understandable, can you then post example of about 10 records with names, ids, acc numbers, etc. replaced with just a format type (i.e. acc number xxxx-xxxx)?

[danovkos]

OK, i will try it. But now i am ill at home. I will post it on tuesday. But thank you for now.