Insert Cells Until Data Matches Up

**Ex0dus** · 09-14-2008, 09:46 PM

I have posted in a existing thread at mrexcel as i believe my problem and possible solution is very similar to that already detailed there. However i have not recieved a response there yet and was looking to draw upon more minds here.

http://www.mrexcel.com/forum/showthread.php?t=294116

My problem is that every month i recieve data for various postcodes. The spreadsheet as such:

Col A....Col B....Col C....Col D
123......6.........123......8
124......6.........125......8
125......7.........126......7
126......6.........127......6
127......7..etc

Previously i have manually inserted 2 cells in Col C & D until Col C matches up with the corresponding postcode (number) in Col A. Col B & D do not have to match, but are rather the actual data attributed to each postcode. Doing it manually is very time consuming and i am seeking an automated method.

Desired end result:

Col A....Col B....Col C....Col D
123......6.........123......8
124......6.....................
125......7.........125......8
126......6.........126......7
127......6.........127......6

(Col C & D have been moved down 1 cell each so that Col C matches the number in Col A)

Note: This is a monthly job that involves adding each new months data on the end. Doing it manually, i would hide previous months so i can more easily match up the postcodes visually. Not sure how this would affect any automated solution. Also as i mentioned in the post on the other forum, occasionally a new number will appear in Col C that does not exist in Col A. I imagine a manual approach will have to be taken here to rectify errors that occur as a result and enable the automation to continue.

**protonLeah** · 09-14-2008, 10:41 PM

The reply posted on MrExcel should have worked for you with minor adjustment; however:

ex0dus-sample.xls

p.s. you may be banned on mrexcel for "hijacking" an old post v.s. starting your own....

**Ex0dus** · 09-14-2008, 11:03 PM

I can't thank you enough. That worked perfectly. Going through thousands of lines in excel matching 2 numbers was proving to be very agonising.

**Ex0dus** · 02-12-2009, 02:29 AM

Hi, i am resurecting this post because an issue has come up and i am so far unable to the figure out a solution to it.

The solution posted originally works great except in the following situation which i recently discovered.

When i insert a set of numbers in column C and D (based on original explanation), and the number in C doesn't exist in Column A, C and D will just be ignored. Like so:

(insert data like this)
Col A....Col B....Col C....Col D
123......6.........123......8
125......7.........124......6
126......6.........126......7
127......6.........127......6

(ends up like this)
Col A....Col B....Col C....Col D
123......6.........123......8
125......7.....................
126......6.........126......7
127......6.........127......6

So basically excel will look to align 124 in Col C, discover there isn't 124 in Col A, then disregard Col C and D (124 & 6).

Is there a way to be notified or similar when it comes across a number in Column C that does not have an equal number in Column A? I guess it is a little bit of the original aim in reverse. It isn't something that comes up often, but currently i don't have a clue when this issue does occur as excel just makes it disappear.

**StewartMorsley** · 02-12-2009, 07:03 AM

I believe this is the coding your looking for:

Dim a As String
Do Until ActiveCell = ""
a = ActiveCell.Value
Selection.Offset(0, 2).Select
If ActiveCell.Value < a Then
Selection.Offset(0, -2).Select
ActiveSheet.Range(Selection, Selection.Offset(0, 1)).Select
Selection.Insert Shift:=xlDown
ElseIf ActiveCell.Value = a Then
Selection.Offset(0, -2).Select
Else: ActiveSheet.Range(Selection, Selection.Offset(0, 1)).Select
Selection.Insert Shift:=xlDown
Selection.Offset(0, -2).Select
End If
Selection.Offset(1, 0).Select
Loop

It should do what you want just sort columns A and B by column A and C and D by column C so the data looks like the table below

124...6 123...3
125...8 124...8
126...9 127...2
127...8 128...2
128...6

once the data is sorted in this way select the cell in column A that is the start of your curent months data and run the macro and it should do the rest for you

**Ex0dus** · 02-12-2009, 06:13 PM

Thanks for that. However when i insert the data and run the script, i am recieving the following error:

run-time error '1004':

Application-defined or object-defined error

I have included the spreedsheet with some of the data i am using that is producing the error.

**StewartMorsley** · 02-12-2009, 07:13 PM

sorry about that i have made amendments to the code

Private Sub CommandButton1_Click()
Dim a As String
Do Until ActiveCell.Value = ""
a = ActiveCell.Value
ActiveCell.Offset(0, 2).Select
If ActiveCell.Value = a Then
ActiveCell.Offset(0, -2).Select
ElseIf ActiveCell.Value = "" Then
ActiveCell.Offset(0, -2).Select
ElseIf ActiveCell.Value < a Then
ActiveCell.Offset(0, -2).Select
ActiveSheet.Range(Selection, Selection.Offset(0, 1)).Select
Selection.Insert Shift:=xlDown
ElseIf ActiveCell.Value > a Then
ActiveSheet.Range(Selection, Selection.Offset(0, 1)).Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(0, -2).Select
End If
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Range("A1").Select
End Sub

**shg** · 02-12-2009, 07:27 PM

Here's another alternative:

Private Sub CommandButton1_Click()
    Dim rL As Range     ' first set of cells on left
    Dim rR As Range     ' first set of cells on right
    
    Set rL = Range("A1:B1") ' change as necessary
    Set rR = Range("C1:D1") ' change as necessary

    ' sort both sides
    Range(rL, rL.End(xlDown)).Sort _
            Key1:=rL(1), Order1:=xlAscending, Header:=xlNo, _
            MatchCase:=False, Orientation:=xlTopToBottom
    Range(rR, rR.End(xlDown)).Sort _
            Key1:=rR(1), Order1:=xlAscending, Header:=xlNo, _
            MatchCase:=False, Orientation:=xlTopToBottom

    ' insert cells left or right as necessary to align entries
    Do
        If rL(1).Value > rR(1).Value And Not IsEmpty(rR(1).Value) Then
            rL.Insert shift:=xlDown
            Set rR = rR.Offset(1)
        ElseIf rL(1).Value < rR(1).Value And Not IsEmpty(rL(1).Value) Then
            rR.Insert shift:=xlDown
            Set rL = rL.Offset(1)
        Else
            Set rL = rL.Offset(1)
            Set rR = rR.Offset(1)
        End If
    Loop Until IsEmpty(rL(1).Value) And IsEmpty(rR(1).Value)
End Sub

**Ex0dus** · 02-12-2009, 07:42 PM

Both of those are working perfectly. Thank you very much. Will definitely have to pick up a book to learn some VBA as it looks to be far more effective than formulas.

**shg** · 02-12-2009, 07:45 PM

Great. Would you please mark the thread as Solved?

Click the Edit button on your first post in the thread

Click Go Advanced, select [SOLVED] from the Prefix dropdown, then click Save Changes

Insert Cells Until Data Matches Up

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Insert Cells Until Data Matches Up

Re: Insert Cells Until Data Matches Up

Re: Insert Cells Until Data Matches Up

Re: Insert Cells Until Data Matches Up

Re: Insert Cells Until Data Matches Up

Re: Insert Cells Until Data Matches Up

Re: Insert Cells Until Data Matches Up

Re: Insert Cells Until Data Matches Up

Thread Information

Users Browsing this Thread

Similar Threads

Clear data in cells with validation

Merge cells which contain the same data

Using "mirror image" of cells to delete duplicate data?

Problem with data sheet and linking it to another sheet to make a report

copying only cells in a filter with data

Bookmarks

Bookmarks

Posting Permissions