Update sheets & cycle

[Sinner]

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

 

[Per Jessen]

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

 

[Sinner]

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





- 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