On Mar 3, 2:23*am, Per Jessen wrote:
Hi

Try this modification. If needed you can add more sheets to the
"shArr" array.

Dim vArr As Variant
* * Dim rCell As Range
* * Dim rDelete As Range
* * Dim nLow As Long
* * Dim nHigh As Long
* * Dim i As Long
* * Dim sTest As String
* * Dim shArr As Variant

Sub Update_List()
* * shArr = Array("Sheet2", "Sheet3", "Sheet4")
* * For sh = 0 To UBound(shArr)
* * With Sheets("Sheet1")
* * * * vArr = .Range(.Cells(1, 1 + sh), _
* * * * * * * * .Cells(.Rows.Count, 1 + sh).End(xlUp)).Value
* * End With
* * nLow = LBound(vArr, 1)
* * nHigh = UBound(vArr, 1)
* * With Sheets(shArr(sh))
* * * * For Each rCell In .Range(.Cells(1, 1), _
* * * * * * * * .Cells(.Rows.Count, 1).End(xlUp))

* * * * * * sTest = rCell.Text
* * * * * * For i = nLow To nHigh
* * * * * * * * If sTest = vArr(i, 1) Then
* * * * * * * * * * If rDelete Is Nothing Then
* * * * * * * * * * * * Set rDelete = rCell
* * * * * * * * * * Else
* * * * * * * * * * * * Set rDelete = Union(rDelete, rCell)
* * * * * * * * * * End If
* * * * * * * * End If
* * * * * * Next i
* * * * Next rCell
* * * * If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
* * End With
* * Next
End Sub

Regards,

Per

On 2 Mar., 21:37, Sinner wrote:



I'm using the following code to update a sheet2 based on values in
first column of sheet1.
I want to modify to cycle across two more sheets against column 2 &
column 3 of sheet1

sheet1----column1-------for------sheet2

sheet1----column2-------for------sheet3
sheet1----column3-------for------sheet4

-------------------------------

Dim vArr As Variant
* * Dim rCell As Range
* * Dim rDelete As Range
* * Dim nLow As Long
* * Dim nHigh As Long
* * Dim i As Long
* * Dim sTest As String

Sub Update_List()

* * With Sheets("Sheet1")
* * * * vArr = .Range(.Cells(1, 1), _
* * * * * * * * .Cells(.Rows.Count, 1).End(xlUp)).Value
* * End With
* * nLow = LBound(vArr, 1)
* * nHigh = UBound(vArr, 1)
* * With Sheets("Sheet2")
* * * * For Each rCell In .Range(.Cells(1, 1), _
* * * * * * * * .Cells(.Rows.Count, 1).End(xlUp))
* * * * * * sTest = rCell.Text
* * * * * * For i = nLow To nHigh
* * * * * * * * If sTest = vArr(i, 1) Then
* * * * * * * * * * If rDelete Is Nothing Then
* * * * * * * * * * * * Set rDelete = rCell
* * * * * * * * * * Else
* * * * * * * * * * * * Set rDelete = Union(rDelete, rCell)
* * * * * * * * * * End If
* * * * * * * * End If
* * * * * * Next i
* * * * Next rCell
* * * * If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
* * End With
End Sub- Hide quoted text -

- Show quoted text -

-----------------------------
Just need to add the following:

Read as:

sheet1----column1-------data to update------sheet2-----data in------
column3

sheet1----column2-------data to update------sheet3-----data in------
column3
sheet1----column3-------data to update------sheet4 ----data in-------
column3
--------------------------

Thx.