Check first five characters and replace offset

[kelseyvdh]

Hi everybody, I've a VBA macro which works, but I want a small change and I can't figure out how to solve it.



The code, as shown below, compares the value in one sheet ("Offer2400HPIN") with the value in another sheet ("Offerte"). Then it replaces the value in Offset 11 with the value from the other sheet.



This works great, but I want to make it so it will only compare the first five characters in the cells. This is because of the fact that the value after the first five characters may differ.



So, for example: If Sheets("Offerte").Range("E14").Value = ABCDEF it must also replace the value in offset 11 if the value in Sheets("Offer2400HPIN").Range("C21") = ABCDEG



You guys have any idea? Many thanks in advance!




Sub quoteUploaden()
On Error Resume Next
Dim Found As Range
Dim lRow As Long
Dim WS As Worksheet
Dim slctCell As Range
Dim FirstRow As Long
Dim FirstRowQuote As Long

Set WS = ThisWorkbook.Worksheets("Offer2400HPIN")
With ActiveSheet
FirstRow = Sheets("Offerte").Range("E158").End(xlUp).Row
FirstRowQuote = WS.Range("C21").End(xlDown).Row
For lRow = 14 To FirstRow
Set Found = Find_All(.Cells(lRow, "E"), WS.Range("C" & 21 & ":" & "D" & FirstRowQuote), , xlWhole)
If Found Is Nothing Then
.Cells(lRow, "P").Interior.Color = vbWhite
Else
.Cells(lRow, "P").Interior.Color = vbGreen
.Cells(lRow, "P") = Found.Offset(0, 11)
Sheets("Offerte").Range("P14:P158").Replace What:=" €", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
Next lRow
End With
End Sub

[offthelip]

use the left function around the string you asre trying to find e.g:

left(.Cells(lRow, "E"),5)

[kelseyvdh]

Thank you for your help, but I cannot seem to make it work. When I put it like this, it will give an error:


Sub quoteUploaden()
On Error Resume Next
Dim Found As Range
Dim lRow As Long
Dim WS As Worksheet
Dim slctCell As Range
Dim FirstRow As Long
Dim FirstRowQuote As Long

Set WS = ThisWorkbook.Worksheets("Offer2400HPIN")
With ActiveSheet
FirstRow = Sheets("Offerte").Range("E158").End(xlUp).Row
FirstRowQuote = WS.Range("C21").End(xlDown).Row
For lRow = 14 To FirstRow
Set Found = Left(.Cells(lRow, "E"), 5), WS.Range("C" & 21 & ":" & "D" & FirstRowQuote), , xlWhole)
If Found Is Nothing Then
.Cells(lRow, "P").Interior.Color = vbWhite
Else
.Cells(lRow, "P").Interior.Color = vbGreen
.Cells(lRow, "P") = Found.Offset(0, 11)
Sheets("Offerte").Range("P14:P158").Replace What:=" €", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
Next lRow
End With
End Sub

[offthelip]

your syntax for hte find staement is wrong try this:


Set Found = WS.Range("C" & 21 & ":" & "D" & FirstRowQuote).find(Left(.Cells(lRow, "E"), 5), , , xlpart)

[kelseyvdh]

Works great! Thank you so much!