How to ignore everything after the second space.
Example:
BA 12345 10-30-2003 must be ---> BA 12345
NM 12345 AB 40893 Must be ----> NM 12345
I am comparing like this: Ucase(cell.value) = Ucase(cell2.value), so
how to add this to these line?
Thanks in advance
Jan
dim intFirstSpaceCell_1 as integer
dim intSecondSpaceCell_1 as integer
dim intFirstSpaceCell_2 as integer
dim intSecondSpaceCell_2 as integer
intFirstSpaceCell_1=instr(cell.value," ")
intSecondSpaceCell_1=instr
(intFirstSpaceCell_1+1,cell.value," ")
intFirstSpaceCell_2=instr(cell1.value," ")
intSecondSpaceCell_2=instr
(intFirstSpaceCell_2+1,cell1.value," ")
then you can do a compare on
ucase$(left$(cell.value,intFirstSpaceCell_1-1))
=ucase$(left$(cell1.value,intFirstSpaceCell_2-1))
rgds
Rog
>.
>
Function CompareTruncate(ByVal String1 As String, ByVal
String2 As String)
String1 = Left(String1, InStr(InStr(String1, " ") + 1,
String1, " ", 1))
String2 = Left(String1, InStr(InStr(String1, " ") + 1,
String1, " ", 1))
CompareTruncate = String1 = String2
End Function
If you set declare
option compare text
there'd be no need for ucase.
In the cell were you want the result of the comparison,
insert
=CompareTruncate(A1,B1)
where A1 and B1 contain the strings you want to compare.
>.
>
I broke things up a bit to make it easier to follow, instead of putting
everything on one line:
========================
Function cmp(rg As Range, rg2 As Range) As Boolean
Dim cell As String, cell2 As String
cell = rg.Value
cell2 = rg2.Value
cell = Application.WorksheetFunction.Substitute(cell, " ", "~", 2)
cell2 = Application.WorksheetFunction.Substitute(cell2, " ", "~", 2)
cell = Left(cell, InStr(1, cell, "~") - 1)
cell2 = Left(cell2, InStr(1, cell2, "~") - 1)
cmp = (UCase(cell) = UCase(cell2))
End Function
==========================
--ron
Function CompareTruncate(ByVal string1 As String, ByVal _
String2 As String)
string1 = Left(string1 & " ", InStr(InStr(string1 & " ", " ") + 1, _
string1 & " ", " "))
String2 = Left(String2 & " ", InStr(InStr(String2 & " ", " ") + 1, _
String2 & " ", " "))
CompareTruncate = UCase(string1) = UCase(String2)
End Function
A14: BA 12345 x
B14: BA 1234
D14: =CompareTruncate(A14,B14)
If you want to try for a worksheet solution:
a14: BA 12345 10-30-2003 must be ---> BA 12345
B14: NM 12345 AB 40893 Must be ----> NM 12345
D14" =IF(UPPER(LEFT(A14 & " ",FIND(" ",RIGHT(A14 & " ",LEN(A14 & " ")-FIND(" ",A14 & " ")))+FIND(" ",A14 & "
")))=UPPER(LEFT(B14 & " ",FIND(" ",RIGHT(B14 & " ",LEN(B14 & " ")-FIND(" ",B14 & " ")))+FIND(" ",B14 & "
"))),"Equal","Differs")
HTH,
David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001]
My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm
Search Page: http://www.mvps.org/dmcritchie/excel/search.htm
"Ajay Askoolum" <ajay.a...@claybrook.co.uk> wrote in message news:27f301c2b7d4$5fd79970$8df82ecf@TK2MSFTNGXA02...
See my correction to Ajay in this thread.
---
HTH,
David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001]
My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm
Search Page: http://www.mvps.org/dmcritchie/excel/search.htm
"Ron Rosenfeld" <ronros...@nospam.org> wrote in message news:k4rq1v4kk09qti2kn...@4ax.com...
cmp = UCase(s1) = UCase(s2)
cmp = StrComp(s1, s2, vbTextCompare) = 0
Although not totally accurate, the results showed that using StrComp in this
way was about 3.5 times faster.
I played around with David's excellent example.
By eliminating the second line of code, and using Instr, I got about a 50%
speed increase.
I may not have the logic correct, but it seems to work. Again, I was just
curious.
Function CompareTruncate(ByVal string1 As String, ByVal _
String2 As String)
string1 = Left(string1 & " ", InStr(InStr(string1 & " ", " ") + 1, _
string1 & " ", " "))
CompareTruncate = InStr(1, String2, string1, vbTextCompare) = 1
End Function
--
Dana DeLouis
Windows XP & Office XP
= = = = = = = = = = = = = = = = =
"David McRitchie" <dmcri...@msn.com> wrote in message
news:exbJDA#tCHA.2352@TK2MSFTNGP09...
Function CompareTruncate(ByVal string1 As String, ByVal _
String2 As String)
string1 = Left(string1 & " ", InStr(InStr(string1 & " ", " ") + 1, _
string1 & " ", " "))
String2 = Left(String2 & " ", InStr(InStr(String2 & " ", " ") + 1, _
String2 & " ", " "))
'-- CompareTruncate = UCase(string1) = UCase(String2)
CompareTruncate = InStr(1, String2, string1, vbTextCompare) = 1
End Function
ba FALSE
ba BA TRUE
ba 12345 ba 12345 TRUE
ba 12345 ba12345 6 FALSE
TRUE
a14 FALSE
B14 b14 TRUE
formulas: =CompareTruncate(A1,B1)
---
HTH,
David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001]
My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm
Search Page: http://www.mvps.org/dmcritchie/excel/search.htm
"Dana DeLouis" <ng_...@hotmail.com> wrote in message news:#xDw4D$tCHA.2588@TK2MSFTNGP12...
>The following will fail with a #Value! because no second space was found
>A14: BA 12345 10-30-2003
>B14: BA 12345
>May not match the exact wording of the original question, but I
>think it would match the intent.
You're correct. I did not do any error checking as I did not know what
sort of results OP wanted in the event of various errors.
I did assume that all valid entries would have at least two spaces.
--ron
--
Dana DeLouis
Windows XP & Office XP
= = = = = = = = = = = = = = = = =
"David McRitchie" <dmcri...@msn.com> wrote in message
news:uSVa6U$tCHA.1668@TK2MSFTNGP09...
Really thanks for your help. But i am using this in an existing macro.
How to add your code to this macro:
Sub ClearTrans()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim Cleared As Worksheet
Dim cell As Range
Dim cell2 As Range
Dim okToCopy As Boolean
Set sh1 = ActiveWorkbook.Sheets(1)
fileToOpen = Application.GetOpenFilename("Excel Files(*.xls),
*.xls", , "Select another Excel-Workbook to eleminate the
transactions...")
If fileToOpen <> False Then
Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0
Set sh2 = ActiveWorkbook.Sheets(1)
End If
ActiveWindow.ActivatePrevious
Set Cleared = Sheets("clear")
LastRow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row
LastRow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row
'Loop through cells on the first sheet
For Each cell In sh1.Range("A22:A" & LastRow1)
'Loop through cells on the second sheet
For Each cell2 In sh2.Range("A22:A" & LastRow2)
' I have to use it here..........
'If tran desc is equal
If UCase(cell.Value) = UCase(cell2.Value) Then
'If debits = credits
If cell.Offset(0, 3) = cell2.Offset(0, 4) Or _
cell2.Offset(0, 3) = cell.Offset(0, 4) Then
okToCopy = False
If Not IsEmpty(cell.Offset(0, 3)) Then
If cell.Offset(0, 3).Value = cell2.Offset(0, 4).Value Then
okToCopy = True
End If
Else
If Not IsEmpty(cell.Offset(0, 4)) Then
If cell.Offset(0, 4).Value = cell2.Offset(0, 3).Value Then
okToCopy = True
End If
End If
End If
If okToCopy Then
'
'Copy the first transaction to a new sheet
cell.Resize(, 12).Cut _
Cleared.Range("A65000").End(xlUp).Offset(1, 0)
'Copy the second transaction to a new sheet
cell2.Resize(, 12).Cut _
Cleared.Range("a65000").End(xlUp).Offset(1, 0)
End If
End If
End If
Next cell2
Next cell
'Clean up variables
Set sh1 = Nothing
Set sh2 = Nothing
Set Cleared = Nothing
Set cell = Nothing
Set cell2 = Nothing
End Sub
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
Replace:
' I have to use it here..........
'If tran desc is equal
If UCase(cell.Value) = UCase(cell2.Value) Then
--with the following:--
'--compare transaction descriptions
If CompareTruncate(cell.value,cell2.value) Then
--
---
HTH,
David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001]
My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm
Search Page: http://www.mvps.org/dmcritchie/excel/search.htm
"Jan Talsma" <anon...@devdex.com> wrote in message news:uXcZQtIuCHA.1636@TK2MSFTNGP12...
Jan