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?
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?