+ Reply to Thread
Results 1 to 2 of 2

Find, and replace but copy cells before replace

Hybrid View

  1. #1
    Forum Contributor
    Join Date
    04-28-2004
    Location
    Norwich, England
    MS-Off Ver
    2010
    Posts
    119

    Find, and replace but copy cells before replace

    Hallo again everybody!

    Firstly –

    I’ve got a simple but long macro to replace any cells that do not contain 49 or 73 and replace them with 49, so that I end up with only a 49 or a 73 in the cells… I am sure you guys know of a much cleverer way to do that bit! At the moment each time I find a number that is not a 49 or 73 I add it to my macro, which is getting longer each month!

    And secondly and more complicated and what I guess I need to do between finding and before replacing non 49 and non 73 cells is –

    When a cell in column E contains something other than 49 or 73 I want to copy that row from A:J to a new spreadsheet

    So if E6 has 25 in for example cells A6:J6 will be copied to a new spreadsheet

    There are lots of rows that will have non 49 and non 73 so what my ultimate goal is, is to end up with one spreadsheet with all the non 49 and 73 cells A:J in it and for all non 49 and non 73 to be changed to 49

    My working but clunky macro so far is as follows –



    Sub CHANGETO49IFNOT73()
    
      Dim Wks As Worksheet
    
    'Select the proper sheet before starting
        Sheets("Europe").Select
    
    'Loop through the Worksheets
       For Each Wks In Worksheets
    
    'Check if the Worksheet is to be skipped -
    
         If Wks.Name = ""Cost" Or Wks.Name = "Front Page" Or Wks.Name = "YTD" Then GoTo Skip
           
    'Prevent screen flicker while running macro
        Application.ScreenUpdating = False
    
    'Activate the worksheet
        Wks.Activate
    
    '.....MAIN MACRO....
    
        Columns("E:E").Select
    
        Selection.Replace What:="10", Replacement:="49", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False
    
        Selection.Replace What:="11", Replacement:="49", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False
    
        Selection.Replace What:="12", Replacement:="49", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False
    
        Selection.Replace What:="14", Replacement:="49", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False
    
        Selection.Replace What:="26", Replacement:="49", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False
    
        Selection.Replace What:="27", Replacement:="49", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False
    
        Selection.Replace What:="30", Replacement:="49", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False
            
        Selection.Replace What:="32", Replacement:="49", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False
    
        Selection.Replace What:="50", Replacement:="49", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False
    
        Selection.Replace What:="58", Replacement:="49", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False
    
    '.....END OF MAIN MACRO....
    
    Skip:
       Next Wks
    
    
    'Return to Front Page
        Sheets("Front Page").Select
        Range("A1").Select
        
        ActiveWorkbook.Save
    
        Application.ScreenUpdating = True
    
    
    End Sub
    Many thanks in advance

    Rae

  2. #2
    Valued Forum Contributor mudraker's Avatar
    Join Date
    11-10-2003
    Location
    Melbourne, Australia
    Posts
    3,983
    Try this macro
    It uses Autofilter & assumes that it has not been set
    Change Sheet names as required
    Try on a backup copy of your workbook 1st

    Sub Macro1()
    
       Dim lLRf As Long
       Dim lLRt As Long
       
       lLRf = Cells(Rows.Count, "e").End(xlUp).Row
       Range("A1:j1").Select
       Selection.AutoFilter
       Selection.AutoFilter Field:=5, Criteria1:="<>49", Operator:=xlAnd, _
            Criteria2:="<>73"
       Rows("2:" & lLRf).Copy
       Sheets("Sheet2").Select
       lLRt = Cells(Rows.Count, "e").End(xlUp).Row + 1
       Cells(lLRt, "A").Select
       Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
           False, Transpose:=False
       Sheets("Sheet1").Select
       Range("e2:e" & lLRf).SpecialCells(xlCellTypeVisible).Value = 49
        
       Selection.AutoFilter Field:=5
       Selection.AutoFilter
    End Sub
    Please Read Forum Rules Before Posting
    Wrap VBA code by selecting the code and clicking the # icon or Read This
    How To Cross Post politely

    Top Excel links for beginners to Experts

    If you are pleased with a member's answer then use the Scales icon to rate it
    If my reply has assisted or failed to assist you I welcome your Feedback.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1