PDA

View Full Version : [SOLVED] Check if cells match but ignore the spaces.



Cinema
02-24-2017, 02:39 AM
Hi,

I have a code that compares the cells in two Workbooks. The cells get a specific interior colour for match & same number, match & different number and
no match.
My Problem is that there are some cells that have spaces. If there is a space before the word in the cell then it gets the colour no match although it has to be a match.

How can I compare the cells irrespective of the spaces?

Here is my code so far:




Sub Compare()
Dim wb1 As Workbook, wb2 As Workbook
Dim sh1, sh2, ws As Worksheet
Dim such As String
Dim wert As Double
Dim Counter1 As Integer
Dim Counter2 As Integer
Dim gefunden As Boolean
Dim sPath As String, sFile1, sFile2, fname1, fname2 As String
Dim letztezeile, zeile As Long

Set wb1 = ThisWorkbook

sPath = wb1.Sheets("Start").Range("B2").Value
fname1 = wb1.Sheets("Start").Range("B3").Value
fname2 = wb1.Sheets("Start").Range("B4").Value
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sFile1 = sPath & fname1
sFile2 = sPath & fname2
Set wb1 = Workbooks.Open(sFile1)
Set wb2 = Workbooks.Open(sFile2)
Set sh1 = wb1.Sheets("RA")
Set sh2 = wb2.Sheets("SA")

wb1.Activate
letztezeile = sh1.Range("C5").End(xlDown).Row
wb2.Activate
zeile = sh2.Columns("L:L").Find("Operational risk", lookat:=xlPart).Row


For Counter1 = 5 To letztezeile
such = wb1.Sheets("RA").Cells(Counter1, 2).Value
wert = wb1.Sheets("RA").Cells(Counter1, 3).Value
wb2.Sheets("SA").Activate
gefunden = False
For Counter2 = 1 To zeile
If Cells(Counter2, 12).Value = such Then
gefunden = True
If Cells(Counter2, 17).Value = wert Then
wb1.Sheets("RA").Activate
Cells(Counter1, 3).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Else
wb1.Sheets("RA").Activate
Cells(Counter1, 3).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With

End If

End If
Next
If gefunden = False Then
wb1.Sheets("RA").Activate
Cells(Counter1, 3).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 3287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With

End If


Next

End Sub

Cinema
02-24-2017, 05:45 AM
Ok you have to do it with LTrim !