Delete and highlight

[Uma Chauhan]

Guys I am trying to clean all excels present in a folder and highlight required data in all excels. Using following code for cleaning excels

Sub Looper()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & ""
    End With
'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
  myExtension = "*.csv*"
'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)
    
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
    
    Cells.Select
    Selection.Replace What:="NA", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    
    'Save and Close Workbook
      wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents
    'Get next file name
      myFile = Dir
  Loop
'Message Box when tasks are completed
  MsgBox "Task Complete!"
ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

And using following code for highlighting:

Sub Highlighter()
'Updateby Extendoffice 20160704
Application.ScreenUpdating = False
Dim Rng As Range
Dim cFnd As String
Dim xTmp As String
Dim x As Long
Dim m As Long
Dim y As Long
cFnd = InputBox("Enter the text string to highlight")
y = Len(cFnd)
For Each Rng In Selection
  With Rng
    m = UBound(Split(Rng.Value, cFnd))
    If m > 0 Then
      xTmp = ""
      For x = 0 To m - 1
        xTmp = xTmp & Split(Rng.Value, cFnd)(x)
        .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
        xTmp = xTmp & cFnd
      Next
    End If
  End With
Next Rng
Application.ScreenUpdating = True
End Sub

Not able to combine the two. Also in highlighter code I want the code to select all cells in range on its own in place of asking to select range first

Please help<strike></strike>

EDIT:
Also if we can make the text to be highlighted non case sensitive, it would help!

 

[igold]

Does this get you any closer to what you want. I don't know if your code was able to open any CSV files, for it to work for me, I had to add a "slash" to the "MyPath" variable. I highlighted that in red...

Sub Looper()


    Dim wb As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog
    Dim Rng As Range
    Dim cFnd As String
    Dim xTmp As String
    Dim x As Long
    Dim m As Long
    Dim y As Long
    
'Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    With FldrPicker
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & ""
    End With
'In Case of Cancel
NextCode:
    [COLOR=#ff0000]myPath = myPath & "\"  'Slash added here[/COLOR]
    If myPath = "" Then GoTo ResetSettings


'Target File Extension (must include wildcard "*")
    myExtension = "*.csv*"
'Target Path with Ending Extention
    myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
    Do While myFile <> ""
    'Set variable equal to opened workbook
        Set wb = Workbooks.Open(Filename:=myPath & myFile)
    
    'Ensure Workbook has opened before moving on to next line of code
        DoEvents
    
    'Cells.Select
        ActiveSheet.UsedRange.Select
        Selection.Replace What:="NA", Replacement:="", LookAt:=xlWhole, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.Delete Shift:=xlUp
    
        ActiveSheet.UsedRange.Select
        cFnd = UCase(InputBox("Enter the text string to highlight"))
        y = Len(cFnd)
        For Each Rng In Selection
            With Rng
                m = UBound(Split(UCase(Rng.Value), cFnd))
                If m > 0 Then
                    xTmp = ""
                    For x = 0 To m - 1
                        xTmp = xTmp & Split(UCase(Rng.Value), cFnd)(x)
                        .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
                        xTmp = xTmp & cFnd
                    Next
                End If
            End With
        Next Rng
    'Save and Close Workbook
        wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
        DoEvents
    'Get next file name
        myFile = Dir
    Loop
'Message Box when tasks are completed
    MsgBox "Task Complete!"
ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub

 

[Uma Chauhan]

Hi igold,

I did not face any issue in the Looper code. The need is to combine looper and the Highlighter code and in highlighter, make the word to be highlighted case insensitive.

 

[igold]

Did you try the code, I thought I did that...