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

 

[mumps]

This macro assumes that the categories in both sheets are not in the same order so it sorts both sheets in alphabetical order to make sure that they are the same. If the categories on both sheets are already in the same order, you can delete the portion in red .

Sub MatchData()
    Application.ScreenUpdating = False
    Dim dewsWS As Worksheet, srcWS As Worksheet, arr1 As Variant, arr2 As Variant, Val As String, x As Long: x = 1
    Set srcWS = ThisWorkbook.Sheets("Sheet1")
    Set desWS = ThisWorkbook.Sheets("Sheet2")
    Dim LastRow1 As Long, LastRow2 As Long
    LastRow1 = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LastRow2 = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With srcWS.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("B1:B" & LastRow1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1:F" & LastRow1)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With desWS.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A1:A" & LastRow2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1:D" & LastRow2)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    arr1 = srcWS.Range("B1", srcWS.Range("B" & Rows.Count).End(xlUp)).Resize(, 2).Value
    arr2 = desWS.Range("A1", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).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 Key:=arr1(i, 1), Item:=arr1(i + 1, 2)
        End If
    Next i
    For i = LBound(arr2, 1) To UBound(arr2, 1)
        If rnglist.Exists(arr2(i, 1)) Then
            desWS.Cells(i, 2) = arr1(i + x, 2)
            x = x + 1
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[trekker1218]

I am attaching 2 screen shots. I cannot upload the actual sample XLS.
Your VBA is crashing. Maybe because the columns are differed.
If you look at sheet 2 you can see that the first attribute should change to BRAND based on Sheet 1 rows 1 & 2 data of Old and New
The sub categories on Sheet2 Col D will be sorted Alpha to match the sort of Sheet 1 COl B

I really appreciate all your help.

 

[mumps]

It would be easier to help if you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[trekker1218]

Book2.xlsx

Shared with Dropbox

www.dropbox.com

 

[trekker1218]

Book2.xlsx

Shared with Dropbox

www.dropbox.com

 

[trekker1218]

It would be easier to help if you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

Any luck ????

 

[mumps]

Try:

Sub matchData()
    Application.ScreenUpdating = False
    Dim LastRow1 As Long, LastRow2 As Long, dewsWS As Worksheet, srcWS As Worksheet, arr As Variant, key As Variant
    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
    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 key:=arr1(i, 1), Item:=arr1(i + 1, 3)
        End If
    Next i
    For Each key In rnglist
        With desWS.Cells(1, 1).CurrentRegion
            .AutoFilter 4, key
        End With
        desWS.Range("E2:E" & LastRow2).SpecialCells(xlCellTypeVisible) = rnglist.Item(key)
    Next key
    desWS.Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[trekker1218]

Hello,
I get this error in the picture attached.
I also loose all the rows on sheet 2 like they are hidden. I can open them .
I did attach the orig files in drop box above if you want to test it.

Thank You SOOOO muchg for your efforts.

 

[mumps]

Click here to download your file. I have changed the "NEW" values in column D of Sheet1 for testing purposes. If you look at Sheet2, you will notice that all the "NEW" values were correctly inserted in column E without any errors. I'm not sure why the macro didn't work for you. Are you using the macro on the same file?