View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Per Jessen[_2_] Per Jessen[_2_] is offline
external usenet poster
 
Posts: 703
Default 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