Update sheets & cycle
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
|