Delete the Rows all at a time,once selected

Question

Consider Below Excel:

Id    Col1     Col2     Col3   Col4
25     s        p         n    
11     a        t         x     g
17                        r     t
10     a                  a     e
66     a                  a

Suppose I have an array which contains the Id numbers
e.g. Arr=(25,11,66)

Is it possible to delete all the rows where the Id number is in that array at once?

Do I need to select them first?

CODE:

 Option Explicit

 Dim arr,objExcel1,strPathExcel1,objSheet1


 Set objExcel1 = CreateObject("Excel.Application")'Object for Condition Dump
 strPathExcel1 = "D:\VA\Test.xlsx"
 objExcel1.Workbooks.open strPathExcel1

 Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(4)


 arr = Array(5,11,66)

 objSheet1.Range("A" & Join(arr, ",A")).EntireRow.Delete

ERROR "Unknown Runtime Error" -- I am getting

Answer 1

EDIT: Further optimize the code

EDIT: Using dictionary to avoid nested loop to increase performance

Please also note that since the tag is vba & vbs, so the answer presented here is compatible in both.

And this solution is deleting the whole row instead of the range containing data only.

EDIT: Updated code to match column A's value with the value inside Arr

Assume that the values from Row 2 onward are Numeric

You can use record macro function provided by Excel to observe how the Range Object is like

http://spreadsheets.about.com/od/advancedexcel/ss/080703macro2007.htm

Sub t()
    Dim str
    Dim arr
    Dim i
    arr = Array(1, 2, 4)
    Dim row
    Dim height
    Dim found
    Dim dataArray
    Dim d
    height = Cells(Rows.Count, 1).End(-4162).row
    ReDim dataArray(height - 2, 0) ' -1 for 0 index, -1 for the first row as header row, excluded
    str = ""
    dataArray = Range(Cells(2, 1), Cells(height, 1)).Value
    Set d = CreateObject("scripting.dictionary")
    For i = LBound(arr) To UBound(arr)
        If Not d.exists(arr(i)) Then
            d(arr(i)) =  0
        End If
    Next
    For i = LBound(dataArray, 1) To UBound(dataArray, 1)
        If d.exists(dataArray(i, 1)) Then
            'found in column 1
            str = str & i & ":" & i & ","
        Else
            'found = False
        End If
    Next
    If Len(str) > 0 Then
        str = Mid(str, 1, Len(str) - 1)
        Range(str).Delete

    End If

End Sub

Answer 2

Here is a brute force method. UPDATED AS PER OP'S LATTER COMMENTS

Code:

Option Explicit


Sub overWriteRows()
Dim d As Object
Dim wkSheet As Worksheet
Dim myRange As Range
Dim myArray As Variant
Dim deleteArray As Variant
Dim finalArray As Variant
Dim upBound As Long, i As Integer
Dim j As Integer, k As Integer, m As Integer

Set d = CreateObject("scripting.dictionary")
Set wkSheet = Sheets("Sheet1") '-- set your own sheet e.g. Sheet2
Set myRange = wkSheet.Range("B3:F8") '-- set your own range e.g. "B2:E5"

'-- validate if range is null or not
If myRnage is nothing then
  Exit Sub
End if

myArray = Application.WorksheetFunction.Transpose(myRange)
'-- now if you do not have delete range in a sheet range then
    '-- you may populate the dictionary right away manually so
        '-- you do not need deleteArray
deleteArray = Application.WorksheetFunction.Transpose(Range("G3:I3"))
'-- if you are populating dictionary manually then
    '-- you may set upBound = Ubound(myArray,2) - d.Count
upBound = UBound(myArray, 2) - UBound(deleteArray)
ReDim finalArray(LBound(myArray, 2) To upBound, LBound(myArray) To UBound(myArray))

'-- replace this with your manual dictionary population code
For i = LBound(deleteArray) To UBound(deleteArray)
    If Not d.exists(deleteArray(i, 1)) Then
        d.Add deleteArray(i, 1), i
    End If
Next i

    k = 1

    For j = LBound(myArray, 2) To UBound(myArray, 2)
        If Not d.exists(myArray(1, j)) Then
        '-- if you want to remove even duplicate records then u can use this
           'd.Add myArray(1, j), k 
                For m = LBound(myArray) To UBound(myArray)
                    finalArray(k, m) = myArray(m, j)
                Next m
                k = k + 1
        End If
    Next j

'-- you may use following code to flush old row data
    'myRange.Value = ""
'-- output the new array to sheet by over writing the old range
'-- you may use myRange instead of "B11" to overwrite old data with filtered data
    wkSheet.Range("B11").Resize(UBound(finalArray), _ 
         UBound(Application.Transpose(finalArray))) = finalArray

    Set d = Nothing
End Sub

Output

Answer 3

Not an answer, but food for thought about optimizing @Larry's solution:

>> a = Array(1, 3, 5, 5, 3, 1)
>> b = Array(1, 2, 3, 4, 5, 6)
>> set c = CreateObject("Scripting.Dictionary")
>> for i = 0 To UBound(a)
>>   c(a(i)) = 0
>> next
>> for i = 0 To Ubound(b)
>>     if c.Exists(b(i)) then
>>        WScript.Echo "delete", i, b(i)
>>     end if
>> next
>>
delete 0 1
delete 2 3
delete 4 5

1. Using dic(key)=value instead of checking via .Exists
2. Avoiding extra variable (found) by exploiting the fact, that .Exists returns bool