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]

getting a runtime error '1004'

 

[trekker1218]

error pic attached

 

[mumps]

Try:

Sub matchData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet, x As Long, fnd As Range, i As Long, rng As Range
    Dim LastRow1 As Long, LastRow2 As Long, myArray1 As Variant, myString1 As String, DataRange1 As Range, lCol1 As Long, fVisRow1 As Long
    Set srcWS = ThisWorkbook.Sheets("Sheet1")
    Set desWS = ThisWorkbook.Sheets("Sheet2")
    LastRow1 = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row
    LastRow2 = desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Row
    lCol1 = srcWS.Cells(1, srcWS.Columns.Count).End(xlToLeft).Column
    lCol2 = desWS.Rows(1).Find("Primary Attribute 30").Column
    For x = 2 To LastRow1 Step 2
        With srcWS.Cells(1).CurrentRegion
            .AutoFilter 2, srcWS.Cells(x, 2)
            fVisRow1 = srcWS.Range("A2", srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
        End With
        With desWS.Cells(1).CurrentRegion
            .AutoFilter 1, srcWS.Cells(x, 2)
            fVisRow2 = desWS.Range("A2", desWS.Cells(desWS.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
        End With
        
        Set DataRange1 = srcWS.Range("D" & fVisRow1).Resize(, lCol1 - 3)
        For Each rng In DataRange1.Cells
            myString1 = myString1 & ";|;" & rng.Value & ";|;" & rng.Offset(1).Value
        Next rng
        myString1 = Right(myString1, Len(myString1) - 3)
        myArray1 = Split(myString1, ";|;")
        
        For i = LBound(myArray1) To UBound(myArray1) Step 2
            Set fnd = desWS.Rows(fVisRow2).Find(myArray1(i), LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                With desWS
                    If myArray1(i + 1) <> "" Then
                        .Range(.Cells(2, fnd.Column), .Cells(LastRow2, fnd.Column)).SpecialCells(xlCellTypeVisible) = myArray1(i + 1)
                    End If
                End With
            End If
        Next i
        myString1 = ""
    Next x
    srcWS.Range("A1").AutoFilter
    desWS.Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[trekker1218]

Holy Crap on a *******..... You did it...
AMAZING,.... it looks perfect on the test file.
I will try on larger files later and let you know.
How can I ever thank you.....

 

[trekker1218]

Happy Thanksgiving to you and all your family....
As always, this board did not disappoint.

 

[mumps]

Thank you and to you as well. Hopefully, we finally got there.