Thnx Alot Doc Sir for helping me in solving this problem
Have a Awesome Day
Problem Solved
Problem 2 solution has minor issue but i corrected it
Code:
' Problem 2a with VBA arrays ' https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)?p=14645&viewfull=1#post14645
Sub SelectOutRowsNotToBeThere_SelectTheRowsIWant() ' Problem 2 ' https://excelfox.com/forum/showthread.php/2582-delete-entire-row-by-vbA
Rem 1 Worksheet data info
Dim WbABC As Workbook, WsABC As Worksheet
Set WbABC = Workbooks.Open(ThisWorkbook.path & "\ABC.xls")
Set WsABC = WbABC.Worksheets.Item(1)
Dim WbDEF As Workbook, WsDEF As Worksheet
Set WbABC = Workbooks.Open(ThisWorkbook.path & "\DEF PROBLEM 2.xlsx") ' this line WbDEF will be there i corrected it
Set WsDEF = WbABC.Worksheets.Item(1)
Dim LrABC As Long, LrDEF As Long
Let LrABC = WsABC.Range("A" & WsABC.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by WsABC
Let LrDEF = WsDEF.Range("B" & WsDEF.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by WsDEF
'Dim arrIn() As Variant
' Let arrIn() = WsABC.Range("A1:K" & LrABC & "").Value2 ' Instead of this i will use Cells in the "magic code line"
Dim arrSrch() As Variant
Let arrSrch() = WsDEF.Range("B1:B" & LrDEF & "").Value2
Dim arrDta() As Variant
Let arrDta() = WsABC.Range("I1:I" & LrABC & "").Value2
Rem 2 get array of indicies for wanted rows
Dim Cnt As Long
Dim strRws As String: Let strRws = "1" ' The string for the indicies will always want the first header row
For Cnt = 2 To LrABC
Dim MtchRes As Variant
Let MtchRes = Application.Match(arrDta(Cnt, 1), arrSrch(), 0)
If IsError(MtchRes) Then Let strRws = strRws & " " & Cnt ' for no match, we want to not delete this row, so do not select it out In other words this code line collects the rows not wanted to be deleted = rows wanted
Next Cnt
Rem 3 Get the indicies in a vertical array, since the "magic code line" needs a vertical array
Dim Rws() As String: Let Rws() = Split(strRws, " ", -1, vbBinaryCompare) ' This gives us a 1 dimensional "horizontal" array ( starting at indicie 0 )
Dim RwsT() As Variant: ReDim RwsT(1 To UBound(Rws) + 1, 1 To 1) ' +1 is needed because the
For Cnt = 1 To UBound(Rws) + 1
Let RwsT(Cnt, 1) = Rws(Cnt - 1)
Next Cnt
Rem 4 get the output array from "magic code line" :
Dim Clms() As Variant
Let Clms() = Evaluate("=Column(A:K)") ' columns 1 2 3 m4 5 6 7 8 9 10 11
Dim arrOut() As Variant
Let arrOut() = Application.Index(WsABC.Cells, RwsT(), Clms()) ' Magic code line http://www.eileenslounge.com/viewtopic.php?p=265384#p265384 http://www.eileenslounge.com/viewtopic.php?p=265384&sid=39b6d764de41f462fe66f62816e5d789#p265384 See also https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172 , http://www.excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp for full explanation
Rem 5 replace worksheet data with modified data arrayOut
WsABC.Cells.ClearContents
Let WsABC.Range("A1").Resize(UBound(arrOut(), 1), 11).Value2 = arrOut() ' We can paste in one go the contents of an arrasy to a worksheet range
Rem Close save workbooks
WbABC.Close Savechanges:=True ' Save the file and close it
WbDEF.Close ' Close file. No changes were made
End Sub
' Conventional macro for comparison: https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)?p=14646&viewfull=1#post14646
Bookmarks