PDA

View Full Version : Solved: Script with cells.find returns wrong values compared to VLOOKUP


nicosdj
07-17-2009, 02:01 AM
Hi


I'm currently working on a vba script in Excel 2007.

I need to copy some data from one sheet to another where I use a unique id as key. I loop thorugh the unique id's and then use Cells.Find to lookup the unique id on the other sheet. My idea was to use Sheets("Destinationsheet").Range("Destinationcelle").Value = ActiveCell.Offset(something, something).Value. But I don't get the same value when using my script as when I use VLOOKUP which I ought to.

When I look in the data sheet VLOOKUP finds the right data but it seems that my script "make up new values" or copy the wrong values.
The first loop copies the correct numbers but in the following loops the numbers are wrong.

My VLOOKUP function looks as follows (translated from Danish but I hope it's correct):


VLOOKUP(LEFT('Forhandlingsenhed U+H sorteret'!J2;6)&"-"&RIGHT('Forhandlingsenhed U+H sorteret'!J2;4);ØSLDV!A4:L599;3;TRUE)+VLOOKUP(LEFT('Forhandlingsenhed U+H sorteret'!J2;6)&"-"&RIGHT('Forhandlingsenhed U+H sorteret'!J2;4);ØSLDV!A4:L599;4;TRUE)+VLOOKUP(LEFT('Forhandlingsenhed U+H sorteret'!J2;6)&"-"&RIGHT('Forhandlingsenhed U+H sorteret'!J2;4);ØSLDV!A4:L599;5;TRUE)+VLOOKUP(LEFT('Forhandlingsenhed U+H sorteret'!J2;6)&"-"&RIGHT('Forhandlingsenhed U+H sorteret'!J2;4);ØSLDV!A4:L599;6;TRUE)+VLOOKUP(LEFT('Forhandlingsenhed U+H sorteret'!J2;6)&"-"&RIGHT('Forhandlingsenhed U+H sorteret'!J2;4);ØSLDV!A4:L599;7;TRUE)+VLOOKUP(LEFT('Forhandlingsenhed U+H sorteret'!J2;6)&"-"&RIGHT('Forhandlingsenhed U+H sorteret'!J2;4);ØSLDV!A4:L599;8;TRUE)+VLOOKUP(LEFT('Forhandlingsenhed U+H sorteret'!J2;6)&"-"&RIGHT('Forhandlingsenhed U+H sorteret'!J2;4);ØSLDV!A4:L599;9;TRUE)+VLOOKUP(LEFT('Forhandlingsenhed U+H sorteret'!J2;6)&"-"&RIGHT('Forhandlingsenhed U+H sorteret'!J2;4);ØSLDV!A4:L599;10;TRUE)+VLOOKUP(LEFT('Forhandlingsenhed U+H sorteret'!J2;6)&"-"&RIGHT('Forhandlingsenhed U+H sorteret'!J2;4);ØSLDV!A4:L599;11;TRUE)+VLOOKUP(LEFT('Forhandlingsenhed U+H sorteret'!J2;6)&"-"&RIGHT('Forhandlingsenhed U+H sorteret'!J2;4);ØSLDV!A4:L599;12;TRUE)


I'm sorry that my script is so untidy but as you can see I've tried many different things.
My script looks as follows:

Sub oesldv_indsaet_data()
'
' oesldv_indsaet_data Makro
'

Dim find_cpr As range
Dim navn As String
Dim navne_der_gav_problemer As String
Dim cpr_numre_der_gav_problemer As String
Dim start_celle_loensam As Long
Dim start_celle_forhandling As Long
Dim cpr As String


On Error GoTo HandleAny:

navne_der_gav_problemer = Empty

start_celle_forhandling = 2

Sheets("Forhandlingsenhed U+H sorteret").Select
range("J" & start_celle_forhandling).Select

start_celle_loensam = 12

'MsgBox "Lige inden løkke..."

'-------------------------------
'Løkke start
'-------------------------------
Do
'MsgBox "Lige inden cpr sættes til ActiveCell..."
cpr = left(ActiveCell.Value, 6) & "-" & Right(ActiveCell.Value, 4)
navn = ActiveCell.offset(0, -8) & " " & ActiveCell.offset(0, -9)

' On Error GoTo ErrHandler:
' Set find_cpr = Sheets("ØSLDV").Cells.Find(What:=cpr, After:=ActiveCell, LookIn:=xlValues, _
' LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
' MatchCase:=False, SearchFormat:=False)


' On Error GoTo HandleAny:

'Kopier data over
' If Not find_cpr Is Nothing Then
'

'MsgBox "Nu vælges ØSLDV-arket..."

'Sheets("ØSLDV").Activate
Sheets("ØLSDV kopieringsark").Activate
range("A1").Activate

'MsgBox "Lige inden søgning... " & cpr & " " & navn

'Sheets("ØSLDV").

On Error GoTo ErrHandler:

' If cpr = Then
'
' Cells.Find(What:=cpr, After:=ActiveCell, LookIn:=xlValues, _
' LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
' MatchCase:=False, SearchFormat:=False).Activate
'
' Exit Sub
'
' Else
Cells.Find(What:=cpr, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

'End If

On Error GoTo HandleAny:

'MsgBox "Lige efter søgning..."


'MsgBox "Resultatet: " & ActiveCell.offset(0, 2).Value + ActiveCell.offset(0, 10).Value

'Løndel 2644 og 3816 omregnet til 97-niveau
' Set loendel1 = (ActiveCell.offset(0, 2).Value + ActiveCell.offset(0, 10).Value)
' loendel1.Copy(Destination:=Sheets("Lønsammensætning").Range("G" & start_celle_loensam))
'
' loendel1.Copy _
' Destination:=Sheets("Lønsammensætning").range("G" & start_celle_loensam)

'-------------------------------------
'Kopierer data i stedet fra ØLSDV kopieringsark
'-------------------------------------

'Løndel 2644 og 3816 omregnet til 97-niveau
range(ActiveCell.offset(0, 2).Address).Value.Copy Destination:=Sheets("Lønsammensætning").range("G" & start_celle_loensam)
'Sheets("Lønsammensætning").range("G" & start_celle_loensam).Value = (ActiveCell.offset(0, 2).Value + ActiveCell.offset(0, 10).Value) '/ Sheets("Faktor").range("A2").Value
'Løndel 3817 omregnet til 97-niveau
range(ActiveCell.offset(0, 3).Address).Value.Copy Destination:=Sheets("Lønsammensætning").range("H" & start_celle_loensam)
'Sheets("Lønsammensætning").range("H" & start_celle_loensam).Value = (ActiveCell.offset(0, 11).Value) '/ Sheets("Faktor").range("A2").Value
'Løndel 3807 - 3815 omregnet til 97-niveau
range(ActiveCell.offset(0, 4).Address).Value.Copy Destination:=Sheets("Lønsammensætning").range("I" & start_celle_loensam)
'Sheets("Lønsammensætning").range("I" & start_celle_loensam).Value = (ActiveCell.offset(0, 3).Value + ActiveCell.offset(0, 4).Value + ActiveCell.offset(0, 5).Value + ActiveCell.offset(0, 6).Value + ActiveCell.offset(0, 7).Value + ActiveCell.offset(0, 8).Value + ActiveCell.offset(0, 9).Value) '/ Sheets("Faktor").range("A2").Value




' If Not (ActiveCell.offset(0, 2).Value + ActiveCell.offset(0, 10).Value) = Sheets("Lønsammensætning").range("O" & start_celle_loensam) Then
' MsgBox "De to beløb er ikke ens. LOPSLAG giver " & Sheets("Lønsammensætning").range("O" & start_celle_loensam) & " mens scriptet giver " & (ActiveCell.offset(0, 2).Value + ActiveCell.offset(0, 10).Value)
' GoTo FortsaetHerfra:
' End If
'
' Sheets("Lønsammensætning").range("G" & start_celle_loensam).Value = (ActiveCell.offset(0, 2).Value + ActiveCell.offset(0, 10).Value) '/ Sheets("Faktor").range("A2").Value
'
' 'Løndel 3817 omregnet til 97-niveau
' Sheets("Lønsammensætning").range("H" & start_celle_loensam).Value = (ActiveCell.offset(0, 11).Value) '/ Sheets("Faktor").range("A2").Value
' 'Løndel 3807 - 3815 omregnet til 97-niveau
' Sheets("Lønsammensætning").range("I" & start_celle_loensam).Value = (ActiveCell.offset(0, 3).Value + ActiveCell.offset(0, 4).Value + ActiveCell.offset(0, 5).Value + ActiveCell.offset(0, 6).Value + ActiveCell.offset(0, 7).Value + ActiveCell.offset(0, 8).Value + ActiveCell.offset(0, 9).Value) '/ Sheets("Faktor").range("A2").Value

' End If


FortsaetHerfra:

start_celle_loensam = start_celle_loensam + 1
start_celle_forhandling = start_celle_forhandling + 1

Sheets("Forhandlingsenhed U+H sorteret").Activate
range("J" & start_celle_forhandling).Activate

ActiveCell.offset(1, 0).Select


Loop Until IsEmpty(ActiveCell) 'start_celle_loensam = 30

'-------------------------------
'Løkke slut
'-------------------------------

'Hvis der ikke var nogle personer der ikke blev fundet returneres der til Lønsammensætningsarket
'Hvis der var nogle problemer bliver Fejlarket vist med de personer der ikke blev fundet

If navne_der_gav_problemer = Empty Then
Sheets("Lønsammensætning").Select
Else
MsgBox "Følgende personer var ikke på listen fra 'ØSLDV' (se dem på arket 'Fejl'): " & vbCrLf & vbCrLf & navne_der_gav_problemer

Sheets("Fejl").range("A4").Value = "Følgende personer var ikke på listen fra 'ØSLDV':"
Sheets("Fejl").range("A5").Value = navne_der_gav_problemer
Sheets("Fejl").range("A6").Value = "Følgende cpr-numre var ikke på listen fra 'ØSLDV':"
Sheets("Fejl").range("A7").Value = cpr_numre_der_gav_problemer

Sheets("Lønsammensætning").Select

End If




Exit Sub
ErrHandler:
navne_der_gav_problemer = navn & "," & vbCrLf & navne_der_gav_problemer
cpr_numre_der_gav_problemer = cpr & "," & vbCrLf & cpr_numre_der_gav_problemer
'MsgBox "Går til Label FortsaetHerfra:..."
Resume FortsaetHerfra:
HandleAny:
MsgBox "Følgende fejl opstod: " & Err.Description & " (fejlnummer " & Err.Number & ")"

End Sub


If it doesn't make sense I can try to delete some of the comments and translate the variables.

I've also tried to make a new sheet which would add up the right cells so that the script only needed to copy one cell to one other cell but that didn't help either.

I simply can't understand why VLOOKUP and my script doesn't produce the same result - can you help?
nicosdj
07-17-2009, 02:03 AM
Wow.
How do I post so that it fits the screen?
mdmackillop
07-17-2009, 05:50 AM
Welcome to VBAX


How do I post so that it fits the screen?

Put linebreaks _
in your code

Can you post a sample workbook? Use Manage Attachments in the Go Advanced reply section.
nicosdj
07-17-2009, 07:48 AM
I've tried to tidy up my code. It now looks as follows:

Sub oesldv_indsaet_data()
'
' oesldv_indsaet_data Makro
'
Dim find_cpr As range
Dim navn As String
Dim names_that_produced_a_problem As String
Dim cpr_numre_der_gav_problemer As String
Dim start_celle_loensam As Long
Dim start_celle_forhandling As Long
Dim cpr As String

On Error GoTo HandleAny:

names_that_produced_a_problem = Empty

start_celle_forhandling = 2

Sheets("Forhandlingsenhed U+H sorteret").Select
range("J" & start_celle_forhandling).Select
start_celle_loensam = 12
'-------------------------------
'Loop start
'-------------------------------
Do
cpr = left(ActiveCell.Value, 6) & "-" & Right(ActiveCell.Value, 4)
navn = ActiveCell.offset(0, -8) & " " & ActiveCell.offset(0, -9)


Sheets("ØSLDV").Activate
range("A1").Activate

On Error GoTo ErrHandler:

Cells.Find(What:=cpr, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

On Error GoTo HandleAny:

Sheets("Lønsammensætning").range("G" & start_celle_loensam).Value = _
(ActiveCell.offset(0, 2).Value + ActiveCell.offset(0, 10).Value) '/ Sheets("Faktor").range("A2").Value
Sheets("Lønsammensætning").range("H" & start_celle_loensam).Value = _
(ActiveCell.offset(0, 11).Value) '/ Sheets("Faktor").range("A2").Value
Sheets("Lønsammensætning").range("I" & start_celle_loensam).Value = _
(ActiveCell.offset(0, 3).Value + ActiveCell.offset(0, 4).Value + ActiveCell.offset(0, 5).Value _
+ ActiveCell.offset(0, 6).Value + ActiveCell.offset(0, 7).Value + ActiveCell.offset(0, 8).Value _
+ ActiveCell.offset(0, 9).Value) '/ Sheets("Faktor").range("A2").Value
FortsaetHerfra:
start_celle_loensam = start_celle_loensam + 1
start_celle_forhandling = start_celle_forhandling + 1
Sheets("Forhandlingsenhed U+H sorteret").Activate
range("J" & start_celle_forhandling).Activate
ActiveCell.offset(1, 0).Select

Loop Until IsEmpty(ActiveCell)
'-------------------------------
'Loop end
'-------------------------------
If names_that_produced_a_problem = Empty Then
Sheets("Lønsammensætning").Select
Else
MsgBox "Følgende personer var ikke på listen fra 'ØSLDV' (se dem på arket 'Fejl'): " _
& vbCrLf & vbCrLf & names_that_produced_a_problem

Sheets("Fejl").range("A4").Value = "Følgende personer var ikke på listen fra 'ØSLDV':"
Sheets("Fejl").range("A5").Value = names_that_produced_a_problem
Sheets("Fejl").range("A6").Value = "Følgende cpr-numre var ikke på listen fra 'ØSLDV':"
Sheets("Fejl").range("A7").Value = cpr_numre_der_gav_problemer

Sheets("Lønsammensætning").Select
End If

Exit Sub
ErrHandler:
names_that_produced_a_problem = navn & "," & vbCrLf & names_that_produced_a_problem
cpr_numre_der_gav_problemer = cpr & "," & vbCrLf & cpr_numre_der_gav_problemer
Resume FortsaetHerfra:
HandleAny:
MsgBox "Følgende fejl opstod: " & Err.Description & " (fejlnummer " & Err.Number & ")"
End Sub


If you want me to change the names of the variables or make more comments please let me know.

It looks like it skips james bond and just copies Harry Potters data to James Bond. Also I have no clue where the 10.044,00 comes from. Any suggestions?

Btw. how can I change the loop so that it copies data for all persons? As it is now it does not copy data for Ronald Weasley. I could of course copy the code inside the loop and then just paste it beneath the loop but there must be a better way?

I could of course count the rows in the "Forhandlingsenhed U+H sorteret" sheet and loop until the number of used rows equals another counter...
nicosdj
07-20-2009, 12:32 AM
Solved.
I realised that I was jumping two persons at a time because I added 1 to my integers, selected the new person (with the use of an integer) and then used ActiveCell.Offset.

My code that works:

Sub oesldv_indsaet_data()
'
' oesldv_indsaet_data Makro
'
Dim find_cpr As range
Dim navn As String
Dim names_that_produced_a_problem As String
Dim cpr_numre_der_gav_problemer As String
Dim start_celle_loensam As Long
Dim start_celle_forhandling As Long
Dim cpr As String

On Error GoTo HandleAny:

names_that_produced_a_problem = Empty

start_celle_forhandling = 2

Sheets("Forhandlingsenhed U+H sorteret").Select
range("J" & start_celle_forhandling).Select
start_celle_loensam = 12
'-------------------------------
'Loop start
'-------------------------------
Do
cpr = left(ActiveCell.Value, 6) & "-" & Right(ActiveCell.Value, 4)
navn = ActiveCell.offset(0, -8) & " " & ActiveCell.offset(0, -9)


Sheets("ØSLDV").Activate
range("A1").Activate

On Error GoTo ErrHandler:

Columns(1).Find(What:=cpr, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

On Error GoTo HandleAny:

' Sheets("Lønsammensætning").range("G" & start_celle_loensam).Value = _
' (ActiveCell.offset(0, 2).Value + ActiveCell.offset(0, 10).Value) '/ Sheets("Faktor").range("A2").Value
' Sheets("Lønsammensætning").range("H" & start_celle_loensam).Value = _
' (ActiveCell.offset(0, 11).Value) '/ Sheets("Faktor").range("A2").Value
' Sheets("Lønsammensætning").range("I" & start_celle_loensam).Value = _
' (ActiveCell.offset(0, 3).Value + ActiveCell.offset(0, 4).Value + ActiveCell.offset(0, 5).Value _
' + ActiveCell.offset(0, 6).Value + ActiveCell.offset(0, 7).Value + ActiveCell.offset(0, 8).Value _
' + ActiveCell.offset(0, 9).Value) '/ Sheets("Faktor").range("A2").Value
'Salarycode 2644 + 3816
Sheets("Lønsammensætning").range("G" & start_celle_loensam).Value = _
(range("C" & ActiveCell.Row).Value + range("K" & ActiveCell.Row).Value) '/ Sheets("Faktor").range("A2").Value
'Salarycode 3817
Sheets("Lønsammensætning").range("H" & start_celle_loensam).Value = _
(range("L" & ActiveCell.Row).Value) '/ Sheets("Faktor").range("A2").Value
'Salarycode 3807-3815 (no data for codes 3810 and 3814)
Sheets("Lønsammensætning").range("I" & start_celle_loensam).Value = _
(range("D" & ActiveCell.Row).Value + range("E" & ActiveCell.Row).Value + range("F" & ActiveCell.Row).Value _
+ range("G" & ActiveCell.Row).Value + range("H" & ActiveCell.Row).Value + range("I" & ActiveCell.Row).Value _
+ range("J" & ActiveCell.Row).Value) '/ Sheets("Faktor").range("A2").Value


FortsaetHerfra:
Sheets("Forhandlingsenhed U+H sorteret").Activate
range("J" & start_celle_forhandling).Activate
ActiveCell.offset(1, 0).Select
start_celle_loensam = start_celle_loensam + 1
start_celle_forhandling = start_celle_forhandling + 1

Loop Until IsEmpty(ActiveCell)
'-------------------------------
'Loop end
'-------------------------------
If names_that_produced_a_problem = Empty Then
Sheets("Lønsammensætning").Select
Else
MsgBox "Følgende personer var ikke på listen fra 'ØSLDV' (se dem på arket 'Fejl'): " _
& vbCrLf & vbCrLf & names_that_produced_a_problem

Sheets("Fejl").range("A4").Value = "Følgende personer var ikke på listen fra 'ØSLDV':"
Sheets("Fejl").range("A5").Value = names_that_produced_a_problem
Sheets("Fejl").range("A6").Value = "Følgende cpr-numre var ikke på listen fra 'ØSLDV':"
Sheets("Fejl").range("A7").Value = cpr_numre_der_gav_problemer

Sheets("Lønsammensætning").Select
End If

Exit Sub
ErrHandler:
names_that_produced_a_problem = navn & "," & vbCrLf & names_that_produced_a_problem
cpr_numre_der_gav_problemer = cpr & "," & vbCrLf & cpr_numre_der_gav_problemer
Resume FortsaetHerfra:
HandleAny:
MsgBox "Følgende fejl opstod: " & Err.Description & " (fejlnummer " & Err.Number & ")"
End Sub