Results 1 to 10 of 27

Thread: Avinash Crap Pending sorting out

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0

    Avinash Crap Pending sorting out

    Moderator Notice:
    In the course of sorting the mess out typically said OP posts, I may need to temporarily to store stuff here. Most stuff here does not really fit anywhere, but I might need bits of it in thee future when straitening out the mess he makes..

    I have this Macro & i am modifying the same as per my needs

    Code:
    Sub STEP6()
    Dim Wbm As Workbook: Set Wbm = ThisWorkbook
    Dim Wb1 As Workbook, Wb2 As Workbook
    Dim strWb1 As String: Let strWb1 = "1.xls"
    Dim strWb2 As String: Let strWb2 = "Error.xlsx"
    
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Dim Lr1 As Long, Lr2 As Long: Let Lr1 = 5000: Lr2 = 5000
    
     Workbooks.Open FileName:=ThisWorkbook.Path & "\" & strWb2
     Set Wb2 = ActiveWorkbook '
     Set Ws2 = Wb2.Worksheets.Item(1)
     Workbooks.Open FileName:=ThisWorkbook.Path & "\" & strWb1
     Set Wb1 = ActiveWorkbook
     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

    changed Macro
    Code:
    Sub STEP6()
    Dim Wbm As Workbook: Set Wbm = ThisWorkbook
    Dim Wb1 As Workbook, Wb2 As Workbook
                                                                                                                           'Dim strWb1 As String: Let strWb1 = "1.xls"
                                                                                                                            'Dim strWb2 As String: Let strWb2 = "Error.xlsx"
    
    Dim Ws1 As Worksheet, Ws2 As Worksheet
                                                                                                                   'Dim Lr1 As Long, Lr2 As Long: Let Lr1 = 5000: Lr2 = 5000(I have to remove the limitation of the macro plz see this line and plz let me know the changes for this also)
    
                                                                                                                       'Workbooks.Open FileName:=ThisWorkbook.Path & "\" & strWb2
     Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Error.xlsx")              'ActiveWorkbook 
     Set Ws2 = Wb2.Worksheets.Item(1)
                                                                                                                         'Workbooks.Open FileName:=ThisWorkbook.Path & "\" & strWb1
     Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")                                                                                                  ' ActiveWorkbook
     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


    Plz see the changes that i made as per my needs
    & I have to remove this line & wanted to remove the limitation of this macro
    Code:
    Dim Lr1 As Long, Lr2 As Long: Let Lr1 = 5000: Lr2 = 5000
    plz suggest instead of this what i have to use & u already shared similar solution but i need cnfirmation from u so plz see and let me know again sir
    Last edited by DocAElstein; 07-26-2020 at 04:37 PM. Reason: Avinash Crap Pending sorting out

Similar Threads

  1. Replies: 14
    Last Post: 07-26-2020, 01:55 PM
  2. Excel Sheet Correction
    By johnny03 in forum Excel Help
    Replies: 1
    Last Post: 12-19-2014, 07:27 AM

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
  •