VBA Change cell vallues in sheet 1 if listed in sheet 2

[Wasserkopf]

Hello all. I'm a newbie, but I have found this website to be the most informative in my quest to learn VBA. Most of the issues I've come across I have been able to solve, but now I'm stumped.

I have a workbook which contains two worksheets, both containing a column (A) with numbers) and a second column B with another set or numbers. "Sheet1" is a master list and "Sheet2" the second sheet is a list of changes that need to be made to the first. I am trying to find a vba code that finds anything in Sheet1/Column A with those in sheet2/column A. If the cells match, change the value of sheet1/column B to what is listed in sheet2/columnB

Example

Sheet1
[TABLE="width: 25"]
<tbody>[TR]
[TD]12345[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]67890[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]23456[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD]78901[/TD]
[TD]21[/TD]
[/TR]
[TR]
[TD]34567[/TD]
[TD]32[/TD]
[/TR]
</tbody>[/TABLE]

Sheet2
[TABLE="class: outer_border, width: 25, align: left"]
<tbody>[TR]
[TD]23456[/TD]
[TD]15[/TD]
[/TR]
[TR]
[TD]34567[/TD]
[TD]10[/TD]
[/TR]
</tbody>[/TABLE]



After the code is run, Sheet1 should look like:
[TABLE="class: outer_border, width: 26"]
<tbody>[TR]
[TD]12345[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]67890[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]23456[/TD]
[TD]15[/TD]
[/TR]
[TR]
[TD]78901[/TD]
[TD]21[/TD]
[/TR]
[TR]
[TD]34567[/TD]
[TD]10[/TD]
[/TR]
</tbody>[/TABLE]

I found the following code to delete cells listed in sheet2, but could not make it work to change the values in sheet1.

Private Sub DeleteFromList()
Dim Row As Long
Dim FoundAgent As Range
Dim LastCell As Long
Dim a As Variant
Dim x As Variant
Sheets("Delete").Activate
LastCell = Sheets("Delete").Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To LastCell
    a = Sheets("Delete").Cells(x, 1).Value
    a = Left(Trim(a), 7)


    Sheets("Delete").Cells(x, 2).Value = a
    EmptyCell = EmptyCell + 1
Next x
Worksheets("Delete").Columns(1).EntireColumn.Delete
For Row = Range("A65536").End(xlUp).Row To 2 Step -1


Set FoundAgent = Sheets("Agent_IDs_with_AUTH_Codes").Range("A:A").Find(Cells(Row, 1), LookIn:=xlValues, lookat:=xlPart)


If Not FoundAgent Is Nothing Then
    Cells(Row, 1).EntireRow.Delete
End If


Next Row
End Sub

In my scenario, the master list has over 1500 entries, so this is a good candidate for a VBA macro. Any help would be greatly appreciated!

Wasserkopf

 

[Takae]

Sheet1 = Delete, Sheet2 =Agent_IDs_with_AUTH_Codes?
Please try this code after put Sheet3 in.

Sub test()
Dim LR As Long, i As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim FC, x(), y(), z
Set ws1 = Sheets("Delete")
Set ws2 = Sheets("Agent_IDs_with_AUTH_Codes")
With ws1
    LR = .cells(Rows.count, 1).End(xlUp).Row
    For i = 2 To LR
    Set FC = ws2.Range("A:A").CurrentRegion.Find(What:=.cells(i, 1).Value, LookIn:=xlValues, lookat:=xlPart)
    If FC Is Nothing Then
        ReDim Preserve x(i - 1)
            x(i - 1) = .cells(i, 1).Value
        ReDim Preserve y(i - 1)
             y(i - 1) = .cells(i, 2).Value
    Else
          ReDim Preserve x(i - 1)
            x(i - 1) = ws2.cells(FC.Row, 1).Value
        ReDim Preserve y(i - 1)
             y(i - 1) = ws2.cells(FC.Row, 2).Value
    End If
    Next
    z = WorksheetFunction.Transpose(x)
    Sheets("Sheet3").Range(Sheets("Sheet3").Range("C1"), .cells(UBound(x) + 1, 3)) = z
    z = WorksheetFunction.Transpose(y)
    Sheets("Sheet3").Range(Sheets("Sheet3").Range("D1"), .cells(UBound(y) + 1, 4)) = z
End With
End Sub

 

[Wasserkopf]

Takae,


Thank you so much for taking the time to write out the code for me. I'm trying to understand what Sheet3 is used for. Also when I run your code the line

z = WorksheetFunction.Transpose(x)

I get a debug error 5 "Invalid procedure call or argument."

I am anxious for your reply and THANK YOU again for taking the time to help me.

Wasserkopf

Sheet1 = Delete, Sheet2 =Agent_IDs_with_AUTH_Codes?
Please try this code after put Sheet3 in.

Sub test()
Dim LR As Long, i As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim FC, x(), y(), z
Set ws1 = Sheets("Delete")
Set ws2 = Sheets("Agent_IDs_with_AUTH_Codes")
With ws1
    LR = .cells(Rows.count, 1).End(xlUp).Row
    For i = 2 To LR
    Set FC = ws2.Range("A:A").CurrentRegion.Find(What:=.cells(i, 1).Value, LookIn:=xlValues, lookat:=xlPart)
    If FC Is Nothing Then
        ReDim Preserve x(i - 1)
            x(i - 1) = .cells(i, 1).Value
        ReDim Preserve y(i - 1)
             y(i - 1) = .cells(i, 2).Value
    Else
          ReDim Preserve x(i - 1)
            x(i - 1) = ws2.cells(FC.Row, 1).Value
        ReDim Preserve y(i - 1)
             y(i - 1) = ws2.cells(FC.Row, 2).Value
    End If
    Next
    z = WorksheetFunction.Transpose(x)
    Sheets("Sheet3").Range(Sheets("Sheet3").Range("C1"), .cells(UBound(x) + 1, 3)) = z
    z = WorksheetFunction.Transpose(y)
    Sheets("Sheet3").Range(Sheets("Sheet3").Range("D1"), .cells(UBound(y) + 1, 4)) = z
End With
End Sub

 

[Wasserkopf]

I got passed the error on line

[COLOR=#333333]z = WorksheetFunction.Transpose(x)[/COLOR]

but now I have an issue with

Sheets("Sheet3").Range(Sheets("Sheet3").Range("C1"), .Cells(UBound(x) + 1, 3)) = z

It throws a runtime error '1004' Application-defined or object-defined error.

Thanks again!

 

[Takae]

Sorry, I didn't test...
Please try again.
z = WorksheetFunction.Transpose(x)
I think this line is correct

Sub test()
Dim LR As Long, i As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim FC, x(), y(), z
Set ws1 = Sheets("Delete")
Set ws2 = Sheets("Agent_IDs_with_AUTH_Codes")
With ws1
    LR = .cells(Rows.count, 1).End(xlUp).Row
    For i = 2 To LR
    Set FC = ws2.Range("A:A").CurrentRegion.Find(What:=.cells(i, 1).Value, LookIn:=xlValues, lookat:=xlPart)
    If FC Is Nothing Then
        ReDim Preserve x(i - 1)
            x(i - 1) = .cells(i, 1).Value
        ReDim Preserve y(i - 1)
             y(i - 1) = .cells(i, 2).Value
    Else
          ReDim Preserve x(i - 1)
            x(i - 1) = ws2.cells(FC.Row, 1).Value
        ReDim Preserve y(i - 1)
             y(i - 1) = ws2.cells(FC.Row, 2).Value
    End If
    Next
    With Sheets("Sheet3")
        z = WorksheetFunction.Transpose(x)
        .Range(.Range("C1"), .cells(UBound(x) + 1, 3)) = z
        z = WorksheetFunction.Transpose(y)
        .Range(.Range("D1"), .cells(UBound(y) + 1, 4)) = z
    End With
End With
End Sub

 

[Wasserkopf]

The code runs, but doesn't do what I need. It seems it is a long-way of copy and pasting the values contained on the"Change" sheet to "Sheet3" beginning at Columns C2 and D2. Nothing in Sheet1/Master list was changed.

"Sheet1" is a master list of over 1500 numbers in the first/A column with corresponding codes in the second/B column. All of the numbers in Column1 are unique.

What I am seeking is code to:

1. Search through "Sheet1"/ColumnA with all the values listed in "Change"/ColumnA. If one of the cells in columnA of "Sheet1" match a cell in ColumnA of "Change", change the value of the cell in "Sheet1"/ColumnB with the value in "Change"/ColumnB.
If the value of "Sheet1"/ColumnA matches the value of "Change"/ColumnA replace "Sheet1"/ColumnB with what is in "Change"/ColumnB

Thank you again for your help.

Wasserkopf

 

[Wasserkopf]

Takae,

Thank you so much for all your help. With you assistance, I was able to find the right code to change the content of the sheet "MasterList" with those on the sheet "Change." I changed the code you provided so that the MasterList is overwritten.

Here's the latest/working code:

Private Sub ChangeMasterList()Dim LR As Long, i As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim FC, x(), y(), z
Set ws1 = Sheets("MasterList")
Set ws2 = Sheets("Change")
With ws1
    LR = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To LR
    Set FC = ws2.Range("A:A").CurrentRegion.Find(What:=.Cells(i, 1).Value, LookIn:=xlValues, lookat:=xlPart)
    If FC Is Nothing Then
        ReDim Preserve x(i - 1)
            x(i - 1) = .Cells(i, 1).Value
        ReDim Preserve y(i - 1)
             y(i - 1) = .Cells(i, 2).Value
    Else
          ReDim Preserve x(i - 1)
            x(i - 1) = ws2.Cells(FC.Row, 1).Value
        ReDim Preserve y(i - 1)
             y(i - 1) = ws2.Cells(FC.Row, 2).Value
    End If
    Next


        z = WorksheetFunction.Transpose(x)
        .Range(.Range("A1"), .Cells(UBound(x) + 1, 1)) = z
        z = WorksheetFunction.Transpose(y)
        .Range(.Range("B1"), .Cells(UBound(y) + 1, 2)) = z
End With
Sheets("MasterList").Activate
Sheets("Change").Cells.ClearContents
Application.ScreenUpdating = True
End Sub

Thanks again for all your help.

Wasserkopf

 

[Wasserkopf]

By the way, I switched the ws1 and ws2 sheets so that it would search for the contents of the sheet "Change" on the "MasterList" sheet. Thank you again!