Replace old content with new content base on Cell

[trekker1218]

Sheet 1

	A	B	C	D	E	F	G	H	I
1	Old	A/C Condensing Units Residential	BTU	Voltage Size	Heating
2	New	A/C Condensing Units Residential​	Cooling BTU	Voltage	Heating BTU
3	Old	A/C Unit Parts (OEM Only)	BTU	Heating	Amperage	Voltage Size
4	New	A/C Unit Parts (OEM Only)	AC COOLING BTU	Heating Area	AMPS	AC VOLTAGE
5

Sheet 2

	a	b	c	d	e	f	g	h	i
1	A/C Condensing Units Residential	BTU	Voltage Size	Heating
2	A/C Unit Parts (OEM Only)	BTU	Voltage Size	Heating
3

I need a VBA or other solution for this:
I need to match the category in sheet1 B1 to Sheet2 A1 Then replace the old data in Sheet2 C1 with the new data in Sheet1 C2. It has to match the Category in Sheet 2 ColA because the old and new data does not always match the columns between sheets. But the OLD and NEW data will always be rows 1 & 2 and 3 & 4 etc...
I have a sheet2 with 50K lines of data that I need to find and replace old data with new data.

Result like this would be great.

	a	b	c	d	e	f
1	A/C Condensing Units Residential	Cooling BTU	Voltage	Heating BTU
2	A/C Unit Parts (OEM Only)	AC COOLING BTU	Heating Area	AMPS	AC VOLTAGE
3
4

Even if it has to write an entire NEW sheet to move the data. That would work. I would just copy and paste the results to the file I need.

Thanks,
Tino

 

[trekker1218]

no problem... You have been a tremendous help already. I am changing the data manually for now. One row at a time. LOL.
I have over 70K rows to go.

No Pressure.... LOL.

 

[mumps]

In sheet2, there are 4 instances of "A/C Commercial VRF". The OLD attribute for Primary Attribute 1 in sheet1 for "A/C Commercial VRF" is "BTU". Will all 4 occurrences on sheet2 always have the same OLD attribute or can each of the four have a different OLD attribute?

 

[trekker1218]

Yes. The OLD attr. are consistent throughout by Category.

 

[mumps]

OK. Give me a little time and I'll see what I can do.

 

[mumps]

Try:

Sub matchData()
    Application.ScreenUpdating = False
    Dim LastRow1 As Long, LastRow2 As Long, desWS As Worksheet, srcWS As Worksheet, arr As Variant, key As Variant
    Dim lCol As Long, attArr As Variant, item As Variant, rng As Range
    Dim myArray As Variant, myString As String, DataRange As Range, cel As Range
    Dim x As Long: x = 2
    Dim y As Long: y = 1
    Set srcWS = ThisWorkbook.Sheets("Sheet1")
    Set desWS = ThisWorkbook.Sheets("Sheet2")
    LastRow1 = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LastRow2 = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lCol = srcWS.Cells(1, srcWS.Columns.Count).End(xlToLeft).Column
    arr1 = srcWS.Range("B2:B" & LastRow1).Resize(, 3).Value
    Set rnglist = CreateObject("Scripting.Dictionary")
    For i = LBound(arr1, 1) To UBound(arr1, 1)
        If Not rnglist.Exists(arr1(i, 1)) Then
            rnglist.Add arr1(i, 1), Nothing
        End If
    Next i
    For Each key In rnglist
        With desWS.Cells(1, 1).CurrentRegion
            If WorksheetFunction.CountIf(desWS.Range("A:A"), key) <> 0 Then
                .AutoFilter 1, key
                Set DataRange = srcWS.Range("D1").Resize(, lCol - 3)
                For Each cel In DataRange.Cells
                    myString = myString & ";|;" & cel.Value & ";|;" & cel.Offset(x).Value & ";|;" & cel.Offset(y).Value
                Next cel
                myString = Right(myString, Len(myString) - 3)
                myArray = Split(myString, ";|;")
                For i = LBound(myArray) To UBound(myArray) Step 3
                    Set att = desWS.Rows(1).Find(myArray(i), LookIn:=xlValues, lookat:=xlWhole)
                    With desWS
                        If .Cells(.Rows.Count, att.Column).End(xlUp).Value = myArray(i + 2) Then
                            .Range(.Cells(2, att.Column), .Cells(LastRow2, att.Column)).SpecialCells(xlCellTypeVisible) = myArray(i + 1)
                        End If
                    End With
                Next i
                x = x + 2
                y = y + 2
            End If
        End With
        myString = ""
    Next key
    desWS.Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

Hopefully, it works and you won't have to reach 70K rows manually.

 

[trekker1218]

It looks like it works but not on actual real data. I am enclosing a small portion of the data here:

TEST-FILE.xlsx

Shared with Dropbox

www.dropbox.com

if you look at sheet 2 COL P and N they should change to the new attributes but don't.

It works fin on the first COL B .

 

[mumps]

Does the data in the file you attached represent the data before or after you ran the macro? If after, please upload the before version.

 

[trekker1218]

After
Ok I will upload in a few minutes.

 

[trekker1218]

Hi, You can use the test files for your macro. The only change was to first 6 rows of Col Brand Name.

 

[trekker1218]

here ya go:

TEST-FILE-BEFORE.xlsx

Shared with Dropbox

www.dropbox.com

Before File