Find and Replace values not equal to

[akjohno]

Hi all, I have some code to change values of say column D in a worksheet. It looks at the values (numeric) and then if it finds say a 400 it replaces that text to "%po", and then if it finds 700 it replaces that with "". I do this using the Selection.Replace so it does it extremely quickly. I now want to be able to replace any other value in that column to the text "%sp" but i want it to do it as fast as possible. is there a way to code the Selection.Replace to do a search for does not equal? I can get the code to work by use Select Case or counter type methods, but as the sheet can have hundreds of thousands of rows I don't want the users to have the annoying flickering if it examining each row by itself and looping through if possible. Part of my code below for reference.

Columns("D:D").Select 'Select the column we want to search for feature codes
Selection.Replace What:="700", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="400", Replacement:="%po", LookAt:=xlWhole, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Regards,
Andrew

 

[Peter_SSs]

My suggestion

I withdraw my earlier suggestion - I had not tested om a large enough sample data set. With 500,000 rows of randomly generated numbers between 300 and 1000 my post #8 code took nearly 4 minutes to complete. On the identical data, the code below took 1.05 seconds so I suggest that you give it a try instead on (a copy of) your large data.

I have assumed that the numbers start in row 2.
If there are no blanks among the data then you can remove the indicated line for another very tiny improvement in speed.
Note also that this is the method suggested by Fazza way back in post #2.

Sub Do_Replacements_Array()
  Dim a As Variant
  Dim i As Long

  With Range("D2", Range("D" & Rows.Count).End(xlUp))
    a = .Value
    For i = 1 To UBound(a)
      Select Case a(i, 1)
        Case 700: a(i, 1) = vbNullString
        Case 400: a(i, 1) = "%po"
        Case ""                     '<- remove if no blank cells
        Case Else: a(i, 1) = "%sp"
      End Select
    Next i
    .Value = a
  End With
End Sub

 

[akjohno]

hi, Andrew

Peter's code likely does what you need. Just be careful if your Excel is before 2010 version as I understand there is an 8,192 different ranges limit on the special cells result & with the large dataset you may have a problem - which can be overcome by sorting column D before the other steps. And this sorting almost certainly give you a good speed gain too (in any Excel version).

regards

Thanks everyone. So this is a survey macro to convert. latitude/longitude coordinates to easting/northing coordinates. Column D is the feature code that tells the end user what the surveyor has picked up, e.g. road, pole, tree etc. Another end user group wants different feature codes for their software so I need to change 700 to a blank cell and 400 to %po and all others to %sp. I have this working now but just need to speed up the macro, in particular the copy and paste of a row that has a bunch of conversion formulae down the sheet to the bottom row of survey data. I currently have a sheet with only 5225 survey points and that process takes about 7 seconds. I get it to copy the master formula row using the range.select and then selection.copy and then paste it to the new range of cells Using the range.select and paste.

 

[Peter_SSs]

Is there a further question here?

using the range.select and then selection.copy and then paste it to the new range of cells Using the range.select and paste.

If you are looking to optimise speed you should avoid 'Selection' in your code. That is a relatively slow process, is almost never necessary and can make a significant difference to run-time.
If you look at the two codes I posted, neither 'selected' anything

 

[akjohno]

Is there a further question here?


If you are looking to optimise speed you should avoid 'Selection' in your code. That is a relatively slow process, is almost never necessary and can make a significant difference to run-time.
If you look at the two codes I posted, neither 'selected' anything

Thanks mate!!! Really appreciate all the help. I'll try this one now and report back if I strike any further issues.

Andrew.

 

[Fazza]

I wonder how this huge dataset gets from whereever it comes from to Excel. SQL can do the conversion you originally requested before the data hits Excel. Thought it worth mentioning

 

[akjohno]

Thanks mate, i'll look into it.

 

[akjohno]

Is there a further question here?


If you are looking to optimise speed you should avoid 'Selection' in your code. That is a relatively slow process, is almost never necessary and can make a significant difference to run-time.
If you look at the two codes I posted, neither 'selected' anything

Peter, thanks for the tip. That drastically increased my macro speed, however my copy and pasting of data is still extremely slow. Is this because I use the Select as you mention? I have copied my macro in to this post (hopefully I did it right). The 3 slow areas are the "Asks you where the file you want to convert is located", the "Copies the co-ordinate converter section of the main file to this dat file" and the "Copy converted co-ordinates back to final sheet" areas. Any suggestions on what I should look into?
Andrew.

On Error GoTo errorhandler
'Variable Declarations
    Dim NumShots As Integer
    Dim wbname As String, fullpath As String, sp As String, coords2 As String
    Dim name1 As String, name2 As String, pastearea As String, pastearea2 As String, coords As String
    Dim cellval As String
    Dim a As Variant
    Dim i As Long
    'Stop screen from flickering while windows change
    Application.ScreenUpdating = False
    
    '   Asks you where the file you want to convert is located
    With Application.FileDialog(msoFileDialogFilePicker)    'Start of picking your file
            .AllowMultiSelect = False               'Allows you to only open one file
            .Filters.Add "Text Files", "*.dat", 1   'Looks only for .dat files
            .Show                                   'Opens the File Dialog Box
        fullpath = .SelectedItems.Item(1)           'Assigns the location of the file to the variable "fullpath"
    End With                                        'Exits the search function
    
    If Right(fullpath, 3) <> "dat" Then             'Error trap in case you don't select a dat file
        MsgBox ("You need to select a .dat file!")  'Message box to advise user that a dat file wasn't selected
        GoTo errorhandler                           'Sends you to the error trap which will close code down
    End If                                          'End of picking your file
    
    'Assigning variable fullpath to full address of file and imports file data into the dat file correctly delimited
    Workbooks.OpenText Filename:= _
        fullpath, _
        Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, _
        Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
    
    wbname = ActiveWorkbook.Name                    'Assigns variable wbname to the name of this workbook
    NumShots = Application.WorksheetFunction.CountA(Range("A:A"))   'Counts the number of survey points in the file
    
    'Copies the co-ordinate converter section of the main file to this dat file
    Windows("CATAN Converter.xlsm").Activate        'Activates main workbook
    Sheets("Sheet2").Visible = True                 'Temporarily unhides Sheet2
    Sheets("Sheet2").Select                         'Selects sheet2 from main workbook
    Cells.Select                                    'Selects the entire contents of worksheet
    Selection.Copy                                  'Copies the contents
    Sheets("Sheet2").Visible = False                'Rehides Sheet2
    Windows(wbname).Activate                        'Goes back and selects our new dat workbook
    Sheets.Add After:=ActiveSheet                   'Creates a new worksheet
    Range("A1").Select                              'Selects cell A1
    
    ActiveSheet.Paste                               'Pastes clipboard contents
    Application.CutCopyMode = False                 'Turns of the clipboard selection
    Range("A1").Select                              'Selects cell A1 to prevent any confusion
    
    pastearea = "G5:AF" & NumShots + 3              'Assigns the variable pastearea the value of the cells we need to paste to
    Range("G4:AF4").Copy Destination:=ActiveSheet.Range(pastearea)  'Copies the formulas from cells G4 to AF4
    Application.CutCopyMode = False                 'Turns off the clipboard selection
    
    ActiveWorkbook.Worksheets(1).Activate           'Selects the first worksheet in the workbook
    pastearea2 = "A1:B" & NumShots                  'Assigns the variable pastearea2 the value of all the cells we need to copy
    ActiveWorkbook.Sheets("Sheet1").Range("D4:E" & NumShots + 3).Value = Range(pastearea2).Value 'same as above but faster
    Application.CutCopyMode = False                 'Turns off the clipboard selection
    Sheets("Sheet1").Select                         'Selects our co-ordinate transformation sheet1
    Range("A1").Select                              'Selects cell A1 to prevent any confusion
    
    'Copy converted co-ordinates back to final sheet
    coords = "AD4:AE" & NumShots + 3                'Assigns the variable coords the value of all the converted co-ordinate cells we need to copy
    Range(coords).Select                            'Selcts all the cells to be copied
    Selection.Copy                                  'Copy the converted co-ordinates
    ActiveWorkbook.Worksheets(1).Activate           'Selects the first worksheet in the workbook again
    coords2 = "A1:B" & NumShots                     'Assigns the variable coords2 the value of the the cells we need to paste to
    Range(coords2).Select                           'Selects the cells to be pasted to
    Selection.PasteSpecial Paste:=xlPasteValues     'Pastes converted co-ordinates back to mainsheet
    Application.CutCopyMode = False                 'Turns off the clipboard selection
    Range("A1").Select                              'Selects cell A1 to prevent any confusion
    Sheets("Sheet1").Select                         'Selects Sheet1
    Application.DisplayAlerts = False               'Turns off Display of box asking to accept sheet deletion
    ActiveWindow.SelectedSheets.Delete              'Deletes Sheet1
    Application.DisplayAlerts = True                'Turns display alerts back on
   
  ' Converts Feature Codes to CATAN usable format
    With Range("D1", Range("D" & Rows.Count).End(xlUp))
        a = .Value
        For i = 1 To UBound(a)
            Select Case a(i, 1)
                Case 700: a(i, 1) = vbNullString
                Case 400: a(i, 1) = "%po"
                Case Else: a(i, 1) = "%sp"
            End Select
        Next i
        .Value = a
    End With
    
    name1 = InStrRev(fullpath, ".")                 'Counts the number of characters in front of the . in the file name
    name2 = Left(fullpath, name1)                   'Grabs the name of the file using the character count above
    'Uses the filename from above and puts csv after it so that it saves to the same location as a different file type
    ActiveWorkbook.SaveAs Filename:= _
    name2 & "csv", FileFormat:=xlCSV, CreateBackup:=False
    MsgBox "File " & name2 & "csv saved to same location as original file location"    'Advises user the file location
    ActiveWorkbook.Close                            'Closes this file
    Workbooks("CATAN Converter.xlsm").Close savechanges:=False  'Closes the Master workbook
Exit Sub
errorhandler:
    MsgBox "Please re-run the code"
    Exit Sub
End Sub

 

[Peter_SSs]

That is far to complicated to work right through, especially without the relevant files. However, you are still 'Activating' and 'Selecting' lots of things when (probably) none are needed at all.
Also, copying the entire cells of a worksheet seems unnecessary!

Here is a simple example of copying what is in 'Sheet2' to a new worksheet in the same workbook without selecting or activating anything (except, by default, the new worksheet will get activated when it is created. But no need to activate Sheet2 or select anything in it and no need to select A1 on the new sheet before pasting.
Also only copying what is used on Sheet2, not all (16,000+columns) x (1,000,000+ rows)

See if you can adapt some more of your code along similar lines and it will run faster.

Sub Demo()
  Dim wsNew As Worksheet
  
  Application.ScreenUpdating = False
  Set wsNew = Sheets.Add(After:=Sheets("Sheet2"))
  Sheets("Sheet2").UsedRange.Copy Destination:=wsNew.Range("A1")
  Application.ScreenUpdating = True
End Sub

 

[akjohno]

That is far to complicated to work right through, especially without the relevant files. However, you are still 'Activating' and 'Selecting' lots of things when (probably) none are needed at all.
Also, copying the entire cells of a worksheet seems unnecessary!

Here is a simple example of copying what is in 'Sheet2' to a new worksheet in the same workbook without selecting or activating anything (except, by default, the new worksheet will get activated when it is created. But no need to activate Sheet2 or select anything in it and no need to select A1 on the new sheet before pasting.
Also only copying what is used on Sheet2, not all (16,000+columns) x (1,000,000+ rows)

See if you can adapt some more of your code along similar lines and it will run faster.

Sub Demo()
  Dim wsNew As Worksheet
 
  Application.ScreenUpdating = False
  Set wsNew = Sheets.Add(After:=Sheets("Sheet2"))
  Sheets("Sheet2").UsedRange.Copy Destination:=wsNew.Range("A1")
  Application.ScreenUpdating = True
End Sub

Wow, thanks. I am very gumby VBA coder Thanks so much i'll go through and check it all out again. I have also found a problem where it is cutting out part way through on some things and I am now wondering if this is because the copy/paste/select stuff is happening over a network drive and the next steps are already happening before the previous steps have finished, cause it only happens when I run it automatically, not when I step into it and wait for each step to complete. Maybe a trap for unwary try hards Thanks again.
Andrew.

 

[Peter_SSs]

You may need to investigate to vba command "DoEvents"