Need CLEAN data? Noone seems to know HOW to get this clean so it can MATCH.. ??????

ChrisOK

Well-known Member
Joined
Mar 26, 2003
Messages
599
I'm sure this surely happened to other people but can't seem to find anyone who knows how to totally resolve the issue. I have a workbook that has data from an outside system (copied in as Paste+Special "Match Destination Formatting") yet when I try to run code to perform a lookup/match procedure, it does not find any matches.

I've attempted running:
=CLEAN
=TRIM
and even this code that sometimes can correct the issue w/ a character replacement code --- but in today's case, it still isn't working.
Code:
Sub Mod_111_12_BOM2TO()

'GETS RID OF GHOST CHARACTERS THAT TRIM AND CLEAN WOULD NOT CLEAR!!!

'Sub EveryCharacter()
     
    Dim i As Long
    Dim L As Long
    Dim c As Range
    Dim r As String
    Dim rng As Range
     
     'Range to search/replace
    Set rng = Range("G9:G100")
     
     'Every Cell!
    For Each c In rng
         'Get length of string in cell
        L = Len(c)
         'If blank go next
        If L = 0 Then GoTo phred
         'Every character...
        For i = 1 To L
            r = Mid(c, i, 1)
             'If current char is outside 'normal' ASCII range
            If r < Chr(32) Or r > Chr(126) Then
                 'delete it
                c.Replace what:=r, replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByColumns, MatchCase:=False
            End If
             'else get next character in cell
        Next
phred:
         'Get next cell
    Next c
 
End Sub

The only thing I have now found that works is.... to:
Select all the data > Copy > Paste at the bottom of the page (let's say there's 100 rows)...
Then, after PASTE+Special+Values
I Select > Copy that data and Paste+Special+Values that data back up where it was.... in rows 8 through whatever..

THEN, I run the code and it is able to perform matches of Part #'s to Part #'s between 2 sheets.
If I don't go through this process --- it does not find any matches...

What in the world causes this? In all my yrs of using Excel, TRIM or CLEAN worked!!
This time not even TRIM, CLEAN or CHAR replacement will work...

All the data is classified as "GENERAL' and all is a combination of text and numbers...

Does anyone out there know how to clean a sheet at once so I don't have to perform this CUT > PASTE
RE-CUT > RE-COPY > RE-PASTE step prior to running code?

Hope someone has a vba solution???
I'm on the last step of my project and this problem is holding me up!
=-(


Here's the code I'm trying to run, but now, I need it to perform extra steps to CUT>PASTE SPECIAL etc prior to this running... does anyone know how to adjust this to correct the problem?
Code:
Sub Mod_13_TO2BOM()

'works great on test file - need to get the real file cleaned so it will
'appropriately allow MATCHING to take place between the 2 sheets using the PN# for matching

'===================================================================
'Sub CompareAndHighlight()

'THIS ONE LOOKS FOR CELLS THAT >>> DO <<< MATCH AND HIGHLIGHTS THEM
'....shows green highlighted rows on the TO so the analyst knows these were found on the BOM and accounted for
'....leaves the items not found with no colorization
'Works GREAT!

    Sheets("TO").Select
    Range("A1").Select

    Dim rng1 As Range, rng2 As Range, k As Integer, j As Integer
    Dim isMatch As Boolean

    For k = 8 To Sheets("TO").Range("B" & Rows.Count).End(xlUp).Row 'START ON ROW 8
        isMatch = True
        Set rng1 = Sheets("TO").Range("B" & k)
        For j = 5 To Sheets("BOM Worksheet").Range("P" & Rows.Count).End(xlUp).Row 'START ON ROW 5
            Set rng2 = Sheets("BOM Worksheet").Range("P" & j)
            If StrComp(Trim(rng1.Text), Trim(rng2.Text), vbTextCompare) = 0 Then
                isMatch = False
                Exit For
            End If
            Set rng2 = Nothing
        Next j


'<<<>>>>THE BELOW SHOWS HOW TO HIGHLIGHT IN 3 DIFFERENT WAYS
'>>>>>>>>>HIGHLIGHT ONLY A CELL
'>>>>>>>>>HIGHLIGHT A ROW TO INFINITY
'>>>>>>>>>HIGHLIGHT A ROW ONLY OUT TO THE END OF WHERE DATA EXISTS

        If Not isMatch Then
            'rng1.Interior.Color = RGB(173, 255, 47) 'THIS ONE highlights ONLY THE CELL
            'rng1.EntireRow.Interior.Color = RGB(173, 255, 47) 'THIS ONE highlights ENTIRE ROW (to infinity)
            With Sheets("TO")
            .Range(.Range("A" & rng1.Row), .Cells(rng1.Row, .Columns.Count).End(xlToLeft)).Interior.Color = RGB(173, 255, 47)
    End With

            'rng1.Value = "Incorrect Name" 'THIS LINE ACTUALLY overwrites the cell with "incorrect name" not sure
            '...............................why anyone would want this - but keeping it in the event I see a need
            
        End If
        Set rng1 = Nothing
    Next k
'End Sub



'====================================================================
'BOTH TO TO BOM AND BOM TO TO MODS WORK PERFECTLY ON "12345 TEST" FILE

'formerly Sub UpdateBOMV3()
'(NEW VERSION FOR REAL FILE)

 'KEEP THIS - IT FINDS CHARS THAT =TRIM AND =CLEAN DO NOT CORRECT
 'Sub EveryCharacter()
    Sheets("TO").Select
 
    Dim i As Long
    Dim L As Long
    Dim c As Range
    Dim r As String
    Dim rng As Range
'================================================
'THIS IS THE ORIG CODE BUT IT only works on the test file not the real file without copy/paste cleaning
'NEED TO CLEAN col B OF THE "TO" TAB SO IT CAN COMPARE THOSE TO THE "BOM" TAB

     'Range to search/replace
        Set rng = Range("B8:B5000")
'================================================
'THIS IS THE NEW CODE BUT IT IS CAUSING ERROR ON L=LEN(C) ROW
'COMMENTING IT OUT FOR NOW UNTIL RESOLVED
'..(((works find when commneted out)))

    'TO DO THE ENTIRE ACTIVE SHEET USE THIS LINE OF CODE INSTEAD:
    'Set rng = ActiveSheet.UsedRange
'================================================
     'Every Cell!
    For Each c In rng
         'Get length of string in cell
        L = Len(c)
         'If blank go next
        If L = 0 Then GoTo phred
         'Every character...
        For i = 1 To L
            r = Mid(c, i, 1)
             'If current char is outside 'normal' ASCII range
            If r < Chr(32) Or r > Chr(126) Then
                 'delete it
                c.Replace what:=r, replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByColumns, MatchCase:=False
            End If
             'else get next character in cell
        Next
phred:
         'Get next cell
    Next c
     
'======================
   
    
    Sheets("TO").Select

Dim x As Range, pnrng As Range, nr As Long
Application.ScreenUpdating = False
With Sheets("TO")
  For Each x In .Range("B8", .Range("B" & Rows.Count).End(xlUp))
    Set pnrng = Sheets("BOM Worksheet").Columns(16).Find(x.Value, LookAt:=xlWhole)


    
'IF NO MATCH BETWEEN "B" OF TO AND "P" OF BOM THEN COPY THE "B" PN FROM TO to the base of the BOM
'ALSO COPY THE NOUN "O", THE UPA "E" to the base of the BOM

    If pnrng Is Nothing Then
      nr = Sheets("BOM Worksheet").Range("P" & Rows.Count).End(xlUp).Offset(1).Row
      With Sheets("BOM Worksheet").Range("P" & nr)
        .Value = x.Value
        .Font.FontStyle = "Bold"
        .Font.Color = 255
      End With
      
      With Sheets("BOM Worksheet").Range("O" & nr)
        .Value = x.Offset(, 4).Value
        .Font.FontStyle = "Bold"
        .Font.Color = 255
      End With
      
      With Sheets("BOM Worksheet").Range("E" & nr)
        .Value = x.Offset(, 5).Value
        .Font.FontStyle = "Bold"
        .Font.Color = 255
      End With
      
    End If
  Next x
  
End With
With Sheets("BOM Worksheet")
  .Columns("E:E").AutoFit
  .Columns("O:P").AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Here's a small example of the file - the way it should look after the code runs... (just FYI) to provide a visual..
I uploaded it to Box:
https://app.box.com/s/a460ia9a3otai6x7mve0
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,517
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Here's some code from David McRitchie you can try on a copy of your data. Select the entire range you want to clean, then run the code.
Code:
Sub TrimALLMcRitchie()
   'David McRitchie 2000-07-03 mod 2002-08-16 2005-09-29 join.htm
   '-- http://www.mvps.org/dmcritchie/excel/join.htm#trimall
   ' - Optionally reenable improperly terminated Change Event macros
      Application.DisplayAlerts = True
      Application.EnableEvents = True   'should be part of Change Event macro
   If Application.Calculation = xlCalculationManual Then
      MsgBox "Calculation was OFF will be turned ON upon completion"
   End If
   
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Dim cell As Range
   'Also Treat CHR 0160, as a space (CHR 032)
   Selection.Replace What:=Chr(160), replacement:=Chr(32), _
     lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   Selection.Replace What:=Chr(13) & Chr(10), replacement:=Chr(32), _
        lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   Selection.Replace What:=Chr(13), replacement:=Chr(32), _
        lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   Selection.Replace What:=Chr(21), replacement:=Chr(32), _
        lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   '---------------------------
   Selection.Replace What:=Chr(8), replacement:=Chr(32), _
      lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   Selection.Replace What:=Chr(9), replacement:=Chr(32), _
      lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   'Trim in Excel removes extra internal spaces, VBA does not
   On Error Resume Next
   For Each cell In Intersect(Selection, _
      Selection.SpecialCells(xlConstants, xlTextValues))
     cell.Value = Application.Trim(cell.Value)
   Next cell
   On Error GoTo 0
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
End Sub
 

ChrisOK

Well-known Member
Joined
Mar 26, 2003
Messages
599
JoeMo and David McRitchie -- you are SAVIORS!!! It works like a charm!
This is EXACTLY what I needed to resolve this last major issue!
Thank you - -- Thank you -- Thank you!!!

Doing the HAPPY DANCE (y)
 

Forum statistics

Threads
1,141,129
Messages
5,704,448
Members
421,350
Latest member
jake9951

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top