Error meddelelse

Placer On Error goto fejl i toppen af makroen.

Plaver fejlhåndteringen i bunden.

Lige inden Fejl: sætter du en Exit Sub

Dette her virker hos mig. Kan ikke få jkrons til at virke.
_______________________
Function Vlookup_AllSheets(opslag, matrix As Range, kol)
Dim ws As Worksheet
Dim StartArk As String
Dim x As Long
Dim var As Variant
StartArk = ActiveSheet.Name
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> StartArk Then
        var = ws.Range(matrix.Address)
        For x = 1 To UBound(var, 1)
          If var(x, 1) = opslag Then
            Vlookup_AllSheets = var(x, kol)
              GoTo slut:
            End If
        Next
    End If
Next
slut:
If Vlookup_AllSheets = "" Then
    MsgBox ("findes ikke")
    Vlookup_AllSheets = "Findes ikke"  'eller
Else
    Vlookup_AllSheets = Vlookup_AllSheets
End If
End Function

Det virker altså heller ikke, den løsning kører også i uendelig løkke.

Prøv den her.


Function Vlookup_AllSheets(opslag, matrix As Range, kol)
Dim ws As Worksheet
Dim StartArk As String
Dim x As Long
Dim var As Variant
'find navnet på det aktive ark
StartArk = Application.Caller.Parent.Name
'for hvert ark i projektmappen hvor formlen er
For Each ws In Application.Caller.Parent.Parent.Worksheets
'hvis arket er forskelligt fra det aktive ark så..
    If ws.Name <> StartArk Then
'hent dataområdet ind i et array
        var = ws.Range(matrix.Address)
'for hvert element i array check første kolonne om elementet er lig det søgte
        For x = 1 To UBound(var, 1)
'hvis det søgte er fundet er resultat = værdien i antal kol til højre
            If var(x, 1) = opslag Then
                Vlookup_AllSheets = var(x, kol)
'hvis fundet så gå ud af løkken
                Exit Function
            End If
        Next
    End If
Next
MsgBox "Not found"
Vlookup_AllSheets = CVErr(xlErrNA)
Set var = Nothing
End Function

Grunden til at der ikke er en "On error goto" er at det man søger jo ikke nødvendigvis findes på 1. ark.
Hvis makroen derimod får lov at køre i bund, så findes det søgte ikke, da den vil springe helt ud af funktion (exit function) hvis den finder noget.

Altså bak, din løsning kører også i uendelig løkke! Jeg kopierede den direkte over, så det kan ikke være fordi jeg har glemt noget. Har du tid lige at kigge på den igen?

Den funker fint her, så hvad putter du i funktionen (parametre) ?
Hvor mange ark har du ?

send evt. dit ark
Tommybak@netscape.net

Det er enormt pænt af dig at du gider bruge tid på det. Det er på arket Tilbud man skal skrive et artikelnummer, som så henter tekst og pris. Du skal ikke tage dig af at det måske ser lidt rodet ud, det er jo ikke færdigt. Jeg sender det.

Circulær referencefejl opstod fordi funktionen også slår op i de bagerste ark hvor du refererer til det ark funktionen ligger.

Jeg har ændret funktionen således at den kun slår op i de ark den begynder med "Group", (som jeg går ud fra var meningen fra starten)


Function Vlookup_AllSheets(opslag, matrix As Range, kol)

Const wsType As String = "Group*"
Dim ws As Worksheet
Dim StartArk As String
Dim x As Long
Dim var As Variant

'find navnet på det aktive ark
StartArk = Application.Caller.Parent.Name
'for hvert ark i projektmappen hvor formlen er
For Each ws In Application.Caller.Parent.Parent.Worksheets
'hvis arket er forskelligt fra det aktive ark så..
    If ws.Name Like wsType Then
'hent dataområdet ind i et array
        var = ws.Range(matrix.Address)
'for hvert element i array check første kolonne om elementet er lig det søgte
        For x = 1 To UBound(var, 1)
'hvis det søgte er fundet er resultat = værdien i antal kol til højre
            If var(x, 1) = opslag Then
                Vlookup_AllSheets = var(x, kol)
'hvis fundet så gå ud af løkken
                Exit Function
            End If
        Next
    End If
Next
Vlookup_AllSheets = CVErr(xlErrNA)
Set var = Nothing
End Function

Fint! Men hvis jeg sætter MsgBox'en på, skal den trykkes væk 5 gange før den forsvinder (fordi der er 5 steder der skal sættes værdi ind), hvordan får jeg den til at forsvinde første gang jeg trykker ok?

Det er ikke så nemt, så hvad med at ændre
Vlookup_AllSheets = CVErr(xlErrNA)

til
Vlookup_AllSheets = "Not Found"

Fint, det kan jeg godt acceptere, tusind tak for hjælpen!