Which is removing certain characters specified in the code from a specific sheet also specified in the code and I need the following changes:
Sub deletenumber() StartRow = 2 LastRow = Cells(Rows.Count, "A").End(xlUp).Row With Application CurrentCalculate = .Calculation CurrentEnableEvents = .EnableEvents .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False End With For X = LastRow To StartRow Step -1 If Cells(X, "A").Value Like "*#*" Then Cells(X, "A").EntireRow.Delete Next With Application .Calculation = CurrentCalculate .EnableEvents = CurrentEnableEvents End With End Sub
2. It should use a dictionary in sheet4, where we can add multiple characters or strings that should be eliminated. As with this code,
Sub removeduplicates() Dim ws As Worksheet For Each ws In Worksheets Select Case ws.Name Case "Sheet2", "Sheet3" 'names of sheets to which code need not be applied ' do nothing Case Else ws.Activate ws.Columns("A:A").Select Call MyRemoveSpaces ws.Range("A" & Rows.Count).End(xlUp).removeduplicates Columns:=1, Header:=xlNo Call deletenumber Call deletewith End Select Next ws End Sub
We use all of these three pieces of code in one loop as following,
Sub findData() Dim f As Range, fa As String, i As Long, r As Range, ws As Worksheet Dim src As Worksheet, dst As Worksheet Set src = Sheets("sheet2") 'sheet to be searched, change as required Set dst = Sheets("Mysheetname") 'sheet for output, change as required i = 1 For Each r In Sheets("Sheet3").Range("A1", Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp)) With dst Set f = src.Cells.Find(What:=r.Value, after:=src.Cells(1), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not f Is Nothing Then Set ws = Sheets.Add(after:=Sheets(Sheets.Count)) ws.Name = r fa = f.Address Do If Len(f.Value) < 80 Then ws.Range("A" & Rows.Count).End(xlUp)(2) = f.Value i = i + 1 End If Set f = src.Cells.FindNext(f) Loop Until fa = f.Address End If fa = "" End With Next r End Sub
Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.