Reputation: 11
Hi guys I am running a macro in Excel 2003 to match property addresses to their owners addresses so I end up with a report of absentee owners.
So in:
column A column C
10 Smith DR Smithville 10 Smith DVE, Smithfield, 49089 Antartica
This is how some of the raw data has been input but I need for this record and all the other slightly different records to be a match and therefore not selected by the macro as it searches for absentee owners addresses then populates the selected records to sheet2. In laymans terms if I could compare say only the first 6 characters in column A to the first 6 characters in column C then I think it would work the way I need it to.
Does anyone know how I can achieve this within my macro shown below
Sub test()
Dim i As Long, lr As Long, r As Long, ws As Worksheet, value As Variant,
val As Variant
Dim sval As Integer, lr2 As Long
Application.ScreenUpdating = False
Set ws = Worksheets("Sheet1")
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lr
value = Split(Cells(i, 1).value, ", ")
For val = LBound(value) To UBound(value)
sval = InStr(1, Cells(i, 3).value, value(val), 1)
If sval = 0 Then Range("A" & i & ":" & "C" & i).Interior.Color = 65535
Next
Next
For r = 2 To lr
lr2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
If Range("A" & r).Interior.Color = 65535 Then
Rows(r).Copy Destination:=Sheets("Sheet2").Rows(lr2 + 1)
lr2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
End If
Next r
Sheets("Sheet2").Cells.Interior.ColorIndex = 0
Application.ScreenUpdating = True
MsgBox "Done Macro"
End Sub
Hopefully I have pasted the code in the correct format required here. So any help and guidance would be much appreciated.
Upvotes: 1
Views: 1566
Reputation: 10113
You can use the formula LEFT()
. This will check the first 6 characters from the cell in column A to the first 6 characters in column C. If there's a match, it will add the value from column A to the next free cell in column A, Sheet2.
Sub First6Characters()
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastRowSheet2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If Left(Range("A" & i), 6) = Left(Range("C" & i), 6) Then
Sheets("Sheet2").Range("A" & LastRowSheet2).Value = Range("A" & i).Value
LastRowSheet2 = LastRowSheet2 + 1
End If
Next i
End Sub
Source: http://www.techonthenet.com/excel/formulas/left.php
Upvotes: 3