Page 8 of 9 FirstFirst ... 6789 LastLast
Results 71 to 80 of 83

Thread: Delete rows based on match criteria in two excel files or single Excel File

  1. #71
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0

    condition not matched then delete entire row(Macro Correction)

    Hi Experts,

    Code:
    Sub STEP6()
    Dim Wb1 As Workbook, Wb2 As Workbook
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Dim Lr1 As Long, Lr2 As Long: Let Lr1 = 5000: Lr2 = 5000
    Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
    Set Ws1 = Wb1.Worksheets(1)
    Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Files\Error.xlsx")
    Set Ws2 = Wb2.Worksheets(1)
    
    Dim rngSrch As Range: Set rngSrch = Ws2.Range("C1:C" & Lr2 & "")
    Dim rngDta As Range: Set rngDta = Ws1.Range("B2:B" & Lr1 & "")
    
    Dim Cnt As Long
        For Cnt = Lr2 To 1 Step -1
        Dim MtchedCel As Variant
         Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
            If Not MtchedCel Is Nothing Then
             rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
            Else
            End If
            
        Next Cnt
     Wb1.Close SaveChanges:=True
     Wb2.Close SaveChanges:=True
    End Sub
    This code has limitation of LR1=5000 & LR2= 5000(plz remove the limitations of this macro)
    & one more issue is there with this macro
    I am sending the sample file plz run the macro & see the output
    If error.xlsx is blank sheet then it is giving something different output plz see
    Attached Files Attached Files

  2. #72
    Junior Member
    Join Date
    Jul 2020
    Posts
    3
    Rep Power
    0
    Last edited by DocAElstein; 07-27-2020 at 09:10 PM.

  3. #73
    Junior Member
    Join Date
    Jul 2020
    Posts
    3
    Rep Power
    0
    .
    Last edited by DocAElstein; 07-26-2020 at 03:25 PM.

  4. #74
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,313
    Rep Power
    10
    Quote Originally Posted by fixer View Post
    This code has limitation of LR1=5000 & LR2= 5000(plz remove the limitations of this macro)
    Avinash,
    Your apparent ability or unwillingness to understand or remember anything is now at such a high level that
    Either
    _1) You are trying deliberately as hard as possible to annoy us
    or
    _2) If _1) is not correct, then you really should now see a Doctor or Psychologist, since you are very likely seriously mentally Ill

    We have had the making last row dynamic issue over and over again. Even just recently almost an identical question from you was answered, and the macro was also almost identical!!!:
    https://eileenslounge.com/viewtopic.php?f=30&t=34937
    https://eileenslounge.com/viewtopic....271316#p271316
    https://excelfox.com/forum/showthrea...ll=1#post14565


    Edit: And you posted this same question a few days before.. Bro you are in a total mixed up mess!!!
    (https://excelfox.com/forum/showthrea...ll=1#post14599 )






    Quote Originally Posted by fixer View Post
    one more issue is there with this macro
    I am sending the sample file plz run the macro & see the output
    If error.xlsx is blank sheet then it is giving something different output plz see
    I have no idea what you are asking. I have no idea what it is that you are trying to say .
    Possibly it is something to do with problem 2 here:
    https://excelfox.com/forum/showthrea...ll=1#post14565
    The problem is your usual incompetence. You mix everything up, and half the time either don’t know what you want or cannot explain what you want. This is not a VBA issue. This is a problem with your brain that needs medical help.

    Alan


    Edit.. and here we go yet once again .... same question
    https://eileenslounge.com/viewtopic....272085#p272085
    _.. same wrong answer...
    https://eileenslounge.com/viewtopic....272094#p272094
    ( wrong caslculation of Lr2 )
    _... and yet agin you think its right ... and another set of duplicated cross postings will begin when you realise yet agin that it is wrong... Bro - you need medical help, fast! NO JOKE!
    Last edited by DocAElstein; 07-27-2020 at 06:22 PM. Reason: Unbelievable!! he stes a new border for total chaos!!
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  5. #75
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0

    Make Lr Dynamics

    Hi Experts,
    I want to make this macro Lr as dynamic

    Code:
    Sub STEP4()
    Dim Wb1 As Workbook, Wb2 As Workbook
    Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\HotStocks\1.xls")
    Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\HotStocks\AlertCodes.xlsx")
    Dim Ws1 As Worksheet, WS2 As Worksheet
    Set Ws1 = Wb1.Worksheets.Item(1)
    Set WS2 = Wb2.Worksheets.Item(4)
    Dim Lr1 As Long, Lr2 As Long: Let Lr1 = 5000: Lr2 = 5000
    Dim rngSrch As Range: Set rngSrch = WS2.Range("B1:B" & Lr2 & "")
    Dim rngDta As Range: Set rngDta = Ws1.Range("I2:I" & Lr1 & "")
    
    Dim Cnt As Long
        For Cnt = Lr2 To 1 Step -1
        Dim MtchedCel As Variant
         Set MtchedCel = rngSrch.Find(What:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
            If Not MtchedCel Is Nothing Then
             rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
            Else
            End If
            
        Next Cnt
     Wb1.Close SaveChanges:=True
     Wb2.Close SaveChanges:=True
    End Sub

    Thnx For the Help




    Code:
    Sub STEP5()
    Dim Wb1 As Workbook, Wb2 As Workbook
    Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
    Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\HotStocks\H2.xlsb")
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Set Ws1 = Wb1.Worksheets.Item(1)
    Set Ws2 = Wb2.Worksheets.Item(2)
    Dim Lr1 As Long, Lr2 As Long:
    Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
    Let Lr2 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
    Dim rngSrch As Range: Set rngSrch = Ws2.Range("A2:A" & Lr2 & "")
    Dim rngDta As Range: Set rngDta = Ws1.Range("B2:B" & Lr1 & "")
    
    Dim Cnt As Long
        For Cnt = Lr2 To 1 Step -1
        Dim MtchedCel As Variant
         Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
            If Not MtchedCel Is Nothing Then
             
            Else
            rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
            End If
            
        Next Cnt
     Wb1.Close SaveChanges:=True
     Wb2.Close SaveChanges:=True
    End Sub
    I changed the lr for this problem Plz see is it perfect?
    Both macros are givng perfect Result But u have recommended it will work sometimes & may be sometimes it will not work thats y i posted this question





    Code:
    Sub STEP6()
    Dim Wbm As Workbook: Set Wbm = ThisWorkbook
    Dim Wb1 As Workbook, Wb2 As Workbook
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Dim Lr1 As Long, Lr2 As Long: Let Lr1 = 5000: Lr2 = 5000
     Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\WolfieeeStyle\9.15\Files\Error.xlsx")
     Set Ws2 = Wb2.Worksheets.Item(1)
     Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
     Set Ws1 = Wb1.Worksheets.Item(1)
    
    Dim rngSrch As Range: Set rngSrch = Ws2.Range("C1:C" & Lr2 & "")
    Dim rngDta As Range: Set rngDta = Ws1.Range("B2:B" & Lr1 & "")
    Dim Cnt As Long
        For Cnt = Lr2 To 1 Step -1
        Dim MtchedCel As Variant
         Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
            If Not MtchedCel Is Nothing Then
             rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
            Else
            End If
            
        Next Cnt
     Wb1.Close SaveChanges:=True
     Wb2.Close SaveChanges:=True
    End Sub

    Code:
    Sub STEP9()
    Dim Wb1 As Workbook, Wb2 As Workbook
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    
    Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
    Set Ws1 = Wb1.Worksheets(1)
    Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\WolfieeeStyle\9.15\Files\Error.xlsx")
    Set Ws2 = Wb2.Worksheets(1)
    Dim Lr1 As Long, Lr2 As Long
    Let Lr1 = Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
    Let Lr2 = Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
    
    Dim rngSrch As Range: Set rngSrch = Ws2.Range("C1:C" & Lr2 & "")
    Dim rngDta As Range: Set rngDta = Ws1.Range("B2:B" & Lr1 & "")
    
    Dim Cnt As Long
        If ActiveSheet.Cells(1, 1) = "" Then
             Wb1.Close SaveChanges:=False
             Wb2.Close SaveChanges:=False
            Exit Sub
        End If
        For Cnt = Lr2 To 1 Step -1
        Dim MtchedCel As Variant
         Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
            If Not MtchedCel Is Nothing Then
             rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
            Else
            End If
            
        Next Cnt
     Wb1.Close SaveChanges:=True
     Wb2.Close SaveChanges:=True
    End Sub
    Last edited by fixer; 08-28-2020 at 10:10 PM.

  6. #76
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,313
    Rep Power
    10
    This is crazy!! I have told you so many times!!!

    Lr1 is for Ws1
    Lr2 is for Ws2

    Lr1 = Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
    Lr2 = Ws2.Range("B" & Ws2.Rows.Count).End(xlUp).Row




    If a macro like those originated from me, which it may well have, then the basic idea , originally, would have been this:
    A row is possibly being deleted in a fairly bog standard conventional worksheet code line in a Loop. Hence it must Loop backwards… Based on the initial given requirement, the macro was doing this: A column of data in a worksheet is gone through/looped. That column would be the rngDta. We can see that in the Loop since at each Loop as the Loop count variable, Cnt , changes, we have the next back/down Item in the rngDta as What:= is being looked for rngDta.Item(Cnt)
    In these macros , it seems that the data is in Ws1 , and the rngDta from a dynamic last row, is given by something of the form
    Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
    That is the data that is gone through/Looped , so the Looping should be done like
    __For Lr1 To 1 Step -1
    The range in which each data item is looked for is rngSrch , which would appear in this macro to be in Ws2 and correspondingly , originally we would have dynamically obtained that range something like
    Ws2.Range("C1:C" & Lr2 & "")
    With our dynamically obtained last row being obtained something like this
    Ws2.Range("B" & Ws2.Rows.Count).End(xlUp).Row
    Based on if a match is or is not found, then something is or isn’t done.




    It is starting to give the impression that you have no access to, or knowledge what so ever of Excel. let alone VBA.
    You often don't / won't understand something that a small mentally handicapped child could and mostly would understand.
    It is clear that there is no real inteligence behind who or what is producing the questions: most of the time you have no idea at all about the questions you are pasting.
    You seem to be pasting badly explained mixed up questions , and as before, posting some canned replies that you don’t seem to understand either yourself half the time.

    Whatever it is you are attempting to do , it is incredibly inefficient, and mostly achieves nothing other than just wasting every bodies time.

    The only amazing thing is that you are getting worse and worse. Whatever you are attempting was, up until now, wasting 10 – 100 times more time than necessary. Your post are now becoming so full of errors and so mixed up that you are wasting 1000 times more than necessary.
    It is totally crazy, and getting crazier by the day… .

    But some people at excelforum seem happy to play the game with you. So maybe best is to just register another dozen accounts there and continue in your games.

    I am beginning to think that your main aim is to just keep as many people possible busy at a forum answering the same and similar questions over and over again… I think there is at least a small chance that you are a Bot are part of an attempt to develop a Bot to ask questions at forums..
    It is clear that there is no real inteligence behind who or what is producing the questions: most of the time you have no idea at all yourself about the questions you are pasting, that is to say duplicate cross posting with multiple accounts everywhere...( https://excelfox.com/forum/showthrea...h-Introduction )
    Last edited by DocAElstein; 08-29-2020 at 03:07 PM.
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  7. #77
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    Np
    i changed all these lr to : Let Lr1 = 10000: Lr2 = 10000
    Simple, I was just trying to make it perfect but No Doubt it will also work & it will work 101% perfect
    I asked the problem bcoz on that day u told sometime it will work or sometime it will not work thats y i asked the question but by putting this line : Let Lr1 = 5000: Lr2 = 5000
    it will work perfect bcoz u have created this macro & u have putted : Let Lr1 = 5000: Lr2 = 5000 this line to the macro & and i was not satisfied with this line : Let Lr1 = 5000: Lr2 = 5000 , but now i will manage it

    I have no more question to ask 99.99%, work is done Bro

    Thnx Doc for helping me for providing me the macros & for putting ur Great Effort in my Research
    Have a Awesome Day

  8. #78
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0

    Delete Entire row by vba (macro Correction)

    Code:
    Sub ApplciationProgram()
        Application.ScreenUpdating = False
        Dim wb1 As Workbook
        Dim wb2 As Workbook
        Dim ws1 As Worksheet
        Dim ws2 As Worksheet
        Dim RowCount1 As Integer
        Dim ColumnCount1 As Integer
        Dim RowCount2 As Integer
        Dim ColumnCount2 As Integer
        Dim OnemyArray() As Variant
        Dim TwomyArray() As Variant
        Dim RowCount As Integer
        Dim sheetNumber As Integer
        Dim rowNumber As Integer
        Dim stateFlag As Boolean
        Dim RowNumbers() As Variant
        Dim Counter  As Integer
        stateFlag = False
    While (Not stateFlag)
        TwoExcellFilePath = "C:\Users\WolfieeeStyle\Desktop\HotStocks\AlertCodes.xlsx"
        sheetNumber = 4
        Set wb1 = ActiveWorkbook
        Set ws1 = wb1.Sheets(3)
        RowCount1 = ws1.UsedRange.Rows.Count
        ColumnCount1 = ws1.UsedRange.Columns.Count
        OnemyArray = ws1.Range("A1:H" & RowCount1).Value
    
        
        Set wb2 = Workbooks.Open(filename:=TwoExcellFilePath)
        Set ws2 = wb2.Sheets(sheetNumber)
        RowCount2 = ws2.UsedRange.Rows.Count
        ColumnCount2 = ws2.UsedRange.Columns.Count
        RowCount = RowCount2
        TwomyArray = ws2.Range("A1:K" & RowCount2).Value
        wb2.Close SaveChanges:=True
        Set wb2 = Nothing
        Counter = 0
        ReDim RowNumbers(RowCount1)
        For i = 2 To RowCount1
            For j = 1 To RowCount2
                If (ws1.Cells(i, 5) = TwomyArray(j, 2) And ws1.Cells(i, 3) = TwomyArray(j, 4)) Then
                    ws1.Rows(i).EntireRow.Delete
                    RowCount1 = ws1.UsedRange.Rows.Count
                End If
            Next
        Next
        wb1.Save
        Set wb1 = Nothing
         Exit Sub
    
    Wend
        Application.ScreenUpdating = True
        Exit Sub
    
    End Sub
    
    
    Function copyFiles(source As String, destination As String)
        Dim fso As Object
        Dim strFileExists As String
        Set fso = CreateObject("scripting.filesystemobject")
        strFileExists = Dir(source)
        If strFileExists > "" Then
            fso.movefile source:=source, destination:=destination
        Else
            MsgBox "File does not exists to copy"
        End If
    End Function
    Function SplitWord(text As String) As String
        Dim indexPoint As Integer
        indexPoint = InStr(text, "-EQ")
        SplitWord = Left(text, indexPoint - 1)
    End Function


    I have a macro to do the same but it is not deleting the entire row so plz see & help me out in the same
    https://www.excelforum.com/excel-pro...orrection.html
    Attached Files Attached Files

  9. #79
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    Problem Solved

  10. #80
    Junior Member
    Join Date
    Feb 2017
    Posts
    8
    Rep Power
    0
    .
    For future readers to learn ... how did you correct the issue ?

Similar Threads

  1. Replies: 29
    Last Post: 06-09-2020, 06:00 PM
  2. Replies: 3
    Last Post: 10-20-2015, 12:51 PM
  3. VBA To Delete Rows Based On Value Criteria In A Column
    By jffryjsphbyn in forum Excel Help
    Replies: 1
    Last Post: 08-15-2013, 12:45 PM
  4. Replies: 6
    Last Post: 08-14-2013, 04:25 PM
  5. Delete Remove Rows By Criteria VBA Excel
    By marreco in forum Excel Help
    Replies: 5
    Last Post: 12-20-2012, 05:56 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •