Matching Multiple Values And Moving Cell Info

[homchz]

I have a list of about 18000 records comparing accounts from two databases. At one point people thought it would be a good idea to have different account numbers...
My list looks like this:
Accounts1.PNG
I can match the First account number And at least the first 7 characters of the address.

I would like it to look like this in the end not sure if it can be done in one sheet or if it has to be populated into it's own sheet:
accounts2.PNG

Any thoughts or direction someone can point me in??

Thanks,

[PCI]

To be clear, you want the same result as for 182P50 to be done for 1848P and 1BEAP01 etc ...
Can you send a short Excel sample

[kvsrinivasamurthy]

Pl upload a sample file.

[Sintek]

Please excuse my ignorance...but why would your outcome not be the same as for 182P50...There doesn't seem to be consistency.

Untitled-1.gif


For above outcome:

Option Explicit
Sub homchz()
Dim ws As Worksheet, i As Long, lRow As Long, rng As Range, cellval As String
Set ws = Sheet1
lRow = ws.Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
With ws
    For i = lRow To 1 Step -1
        Set rng = Range("B" & i & ":B" & lRow)
            cellval = Range("B" & i).Value
            If Application.WorksheetFunction.CountIf(rng, cellval) > 1 Then
                With .Range("B:B")
                    Set rng = .Find(What:=cellval, _
                                After:=.Cells(1), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False)
                    If Not rng Is Nothing Then
                        rng.Offset(, 1).Copy rng.Offset(-1, 1)
                        rng.EntireRow.Delete
                    End If
                End With
            End If
    Next i
End With
Application.ScreenUpdating = True
End Sub

[jindon]

If no header and data starts from A1.
Simply

Sub test()
    With Cells(1).CurrentRegion.Columns(3)
        .Value = .Offset(1).Value
    End With
End Sub

Otherwise, need to see your workbook.

[homchz]

The data is merged like accounts from two different data bases that were set up differently. So in one system the account number is 182P50 with a site location of 182P500000. And the other is 182P50 with a site location of BOST. But I need to find a way to easily relate the two together in one sheet for a data import into a new system.

So this is to match the 182P500000 to BOST. And so on through out the entire spread sheet.

Attached is a small sample of accounts. Some have matches, some do not. Some are not right above the others one for one.

Thanks,

[PCI]

Thanks for the file
What about
16AP50 SPRI
16AP50 EAST
16AP50 LONG
16AP50 16AP500000
16AP50 16AP500001
16AP50 16AP500002

What is the final result ??

[homchz]

If there is no matching address. The I would like to to remain blank as that will tell me what addresses are not populated in the main database and I will have to create by hand.

if the Street address matches Ultimately I am looking for

16AP50 16AP500000 (No Matching address in Address_1 or Address_2 so leave Blank)
16AP50 16AP500000 (No Matching address in Address_1 or Address_2 so leave Blank)
16AP50 16AP500002 SPRI

Hope that makes sense.

[PCI]

If my understanding is right you want to merge data into one row when:
"CustomerNumber" and "Site Name" and "Address_1" and "Address_2" are the same
then "Site_Id" and "ShipToCode" will exist only once and must be recorded in the final row
Is it ?
If not, please show in your final the final result you need

[homchz]

If my understanding is right you want to merge data into one row when:
"CustomerNumber" and "Site Name" and "Address_1" and "Address_2" are the same
then "Site_Id" and "ShipToCode" will exist only once and must be recorded in the final row
Is it ?
If not, please show in your final the final result you need

That is it.

[PCI]

Perhaps try
Note: There is some spaces in column "CustomerNumber" they are removed in the macro

Option Explicit
Sub Treat()
Dim DataDic   As Object
Set DataDic = CreateObject("Scripting.Dictionary")
Dim LR  As Integer, I  As Integer, II  As Integer, FR  As Integer
Const CustNbCol  As String = "B"
Const SiteNamCol  As String = "E"
Const Add1Col  As String = "F"
Const Add2Col  As String = "G"
Const SiteIdCol  As String = "C"
Const ShipToCodCol  As String = "D"
Dim Temp
Dim DelRg As Range
    FR = 2
    LR = Cells(Rows.Count, CustNbCol).End(3).Row
    With DataDic
        For I = LR To FR Step -1
            Temp = Trim(Cells(I, CustNbCol)) & "/" & Cells(I, SiteNamCol) & "/" & Cells(I, Add1Col) & "/" & Cells(I, Add2Col)
            If (.exists(Temp)) Then
                II = .Item(Temp)
                If (Cells(I, SiteIdCol) = "") Then Cells(I, SiteIdCol) = Cells(II, SiteIdCol)
                If (Cells(I, ShipToCodCol) = "") Then Cells(I, ShipToCodCol) = Cells(II, ShipToCodCol)
                Cells(II - 1, 1).ListObject.ListRows(II - 1).Delete
            End If
            .Item(Temp) = I
        Next I
    End With
End Sub