Vba til flytning eller sletning af værdi i celle

Sagen er, at jeg bruger det til indkøb og hver ark er måned.
Når jeg får en ordre med varenr hjem, så skal den tidligere ordre og dermed varenr slettes, så feltet står tomt.
Jeg har alle mine ordrer leveret dag til dag, så får først ordren/varenr hjem når det gamle er opbrugt.
Så det er for overskuelighedens skyld og det faktum, at jeg bare kan køre videre med denne workbook i uendelighed.

Og samtidig så bruger jeg dele af samme type ark som lagerstyring af færdig producerede varer.
Varer som ændrer lokationer både internt og eksternt.
Her vil jeg også kunne bruge denne vba som en mulighed.

I hvilke kolonner er varenr. placeret?

De kan være i samtlige kolonner fra A:AN men ikke nødvendigvis i alle rækker.
Enkelte rækkenumre kan stå tomme.

Min range er fra A:AN i samtlige sheets.
Der er rigtig mange numre, da der er varenr på alle små ordre/dimser.
Så jeg har vel små 2000 varenumre fordelt over de 12 sheets.
Sheet 1 kan eksempelvis indeholde varenumre i A:1, A:4, A:4, B:3, C:7, F:7 osv osv.
Det samme i de andre sheets.

Har skrevet den basale VBA-kode - men er ikke færdig med detaljen.
Men det er ikke et problem at opfylde det ønskede..
Fortsætter i morgen.

PS: Lidt VBA-kursus/undervisning/Mentoring kan evt. også klares.

Dim antalArk As Integer
Dim vareNr As Long, arkNr As Integer
Dim antalRækker As Integer, antalKolonner As Integer
Dim arkNavn As String, dubLetAdresse As String
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'    Stop
    vareNr = Target
    arkNavn = ActiveSheet.Name
   
    For arkNr = 1 To ActiveWorkbook.Sheets.Count
        If arkNavn <> Sheets(arkNr).Name Then
            Sheets(arkNr).Activate
            antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
            antalKolonner = ActiveCell.SpecialCells(xlLastCell).Column
           
            dubLetAdresse = findesDublet
            If dubLetAdresse <> "" Then
                MsgBox dubLetAdresse
            End If
        End If
    Next arkNr
End Sub
Private Function findesDublet()
    With Sheets(arkNr).Range(Cells(1, 1), Cells(antalRækker, antalKolonner))
        Set c = .Find(vareNr, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findesDublet = c.Address
        Else
            findesDublet = ""
        End If
    End With
End Function

Det lyder super, begge dele.
Har også lige hurtigt tjekket dit link til http://supertekst-it.dk/.
Glæder mig til, at se videre på koden i morgen.
Tak indtil videre..

Ok - det bliver lidt senere i dag - har et problem for en kunde jeg skal have løst først.

ren Version 2
Dim antalArk As Integer
Dim vareNr As Long, arkNr As Integer
Dim antalRækker As Integer, antalKolonner As Integer
Dim arkNavn As String, dubLetAdresse As String, flag As Boolean
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim svar As Integer
'Stop
    Application.ScreenUpdating = False
   
    If flag = False Then
        vareNr = Target
        arkNavn = ActiveSheet.Name
    End If
   
    For arkNr = 1 To ActiveWorkbook.Sheets.Count
        If arkNavn <> Sheets(arkNr).Name And flag = False And Target <> "" Then
            Sheets(arkNr).Activate
            antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
            antalKolonner = ActiveCell.SpecialCells(xlLastCell).Column
           
            dubLetAdresse = findesDublet
            If dubLetAdresse <> "" Then
                svar = MsgBox("Varenr. eksistere allerede i ark " & arkNr & ", vil du oprette alligevel?", vbOKCancel, "Dublet-test")
                If svar = 1 Then
                    flag = True
                    ActiveSheet.Range(dubLetAdresse) = ""
                    flag = False
                    Exit For
                Else
                    Target = ""
                End If
            End If
        End If
    Next arkNr
   
    Sheets(arkNavn).Activate
End Sub
Private Function findesDublet()
    With Sheets(arkNr).Range(Cells(1, 1), Cells(antalRækker, antalKolonner))
        Set c = .Find(vareNr, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findesDublet = c.Address
        Else
            findesDublet = ""
        End If
    End With
End Function

Skal jo også passes :-)

Det ser godt ud, kigger lige på den igen i morgen.
Måske lidt herhjemme i aften og vender tilbage.
Tak for hjælpen so far.

Ok - og selv tak

Vender også lige tilbage omkring VBA kursus senere, men nu har jeg jo dine oplysninger :-)

..også Ok

Hmm, det virker næsten.
Eneste problem er, at den ikke reagerer på, hvis jeg opretter varenummeret i samme ark som der er et allerede.
Jeg får jo nogle gange 2 leveringer I samme måned/sheet.
Jeg har et enkelt felt I ark nr 1 som søgefelt på varenr.
Jeg har forgæves forsøgt, at få den til at exit sub med denne:

If ActiveSheet.Name = "Ark1" And Target.Address = "$AI$1" Then Exit Sub

-ellers er det faktisk ganske godt.

Har bevidst undtaget den aktuelle side i koden da jeg ikke forestillede mig dette som relevant, men kan der laves om på
Altså version 3 vil blive udviklet

Det vil være rigtig fedt, hvis det kan lade sig gøre

Er stadig i gang med en kundeudfordring - så det må vente lidt..

Ja, selvfølgelig :-)
Det haster heller ikke og jeg bruger det der er indtil videre.
Hvis du giver et svar, så kan du lige få point.

Ok - det får du så - men jeg skal nok vende tilbage

Super, skal jo også høre mere om lidt VBA kursus osv.

Rem I en pause kunne jeg så lige.. - inden hovedet røg helt af :-)
rem #21 kan det vente lidt - men prøv at nedskriv dine tanker om hvad og hvordan - så er du velkommen til at sende via mail - @-adresse under min profil.

Rem Version 3
Dim antalArk As Integer
Dim vareNr As Long, arkNr As Integer
Dim antalRækker As Integer, antalKolonner As Integer
Dim arkNavn As String, dubLetAdresse As String, flag As Boolean, adr As String
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim svar As Integer
'Stop
    Application.ScreenUpdating = False
   
    If flag = False Then
        vareNr = Target
        adr = Target.Address
        arkNavn = ActiveSheet.Name
    End If
   
    For arkNr = 1 To ActiveWorkbook.Sheets.Count
        If flag = False And Target <> "" Then
            Sheets(arkNr).Activate
            antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
            antalKolonner = ActiveCell.SpecialCells(xlLastCell).Column
           
            dubLetAdresse = findesDublet
            If ActiveSheet.Name = "Ark1" And Target.Address = "$AI$1" Then
                Exit For
            Else
                If dubLetAdresse <> "" And dubLetAdresse <> adr Then
                    svar = MsgBox("Varenr. eksistere allerede i ark " & arkNr & ", vil du oprette alligevel?", vbOKCancel, "Dublet-test")
                    If svar = 1 Then
                        flag = True
                        ActiveSheet.Range(dubLetAdresse) = ""
                        flag = False
                        Exit For
                    Else
                        Target = ""
                    End If
                End If
            End If
        End If
    Next arkNr
   
    Sheets(arkNavn).Activate
End Sub
Private Function findesDublet()
    With Sheets(arkNr).Range(Cells(1, 1), Cells(antalRækker, antalKolonner))
        Set c = .Find(vareNr, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findesDublet = c.Address
        Else
            findesDublet = ""
        End If
    End With
End Function

Super, du hører fra mig på mail, men der går nok lige 1-2 uger.
Ps. Kan den ændres til, at skrive ark navn i stedet for nr, altså der hvor dubletten er i forvejen?
Tænker Januar, Februar osv i stedet for ark 1, ark 2 osv.
Bare en lille detalje, men hvis det er for besværligt at ændre, så går det andet også an.

Vi mailes lige ved :/)

Ok - PS.: Ja - men jeg skal lige høre om arknavne er månedsnavnene eller VBA skal genererer navnet på basis af nr.

Hvis den kan generere navnet, så det passer i forhold til fanens navn, så vil det være perfekt.
Altså så det ændres automatisk, hvis jeg ændrer navnet på fanerne senere.

Hvis du forstår hvad jeg mener?
Bruger nemlig samme vba kode i en lokations mappe, hvor jeg flytter emner og der hedder fanerne noget andet.

Ok jeg prøver

Ok, men hvis det er nemmere at skrive navnene på arkene som Januar, Februar osv i vba, så kan jeg også selv rette navnene i koden, hvis jeg ændrer på fane navnene.
Er ikke så meget inde i vba, at jeg ved hvordan det skal gøres, der er du eksperten :-)
Jeg sætter virkelig stor pris på din hjælp og håber at jeg får tvunget et kursus/mentoring igennem hos min arbejdsgiver.
Men de plejer, at være til at snakke med og vi har haft drøftet det tidligere, hvor jeg er blevet bedt om, at undersøge mulighederne.
Og når de kan se, hvad du har hjulpet med mig her, så er det også lidt nemmere :-)

Tak :-)
Nu prøver jeg at rette så den viser navnet, som de enkelte ark har.
Det er intet problem.

Rem Version 4
Dim antalArk As Integer
Dim vareNr As Long, arkNr As Integer
Dim antalRækker As Integer, antalKolonner As Integer
Dim arkNavn As String, dubLetAdresse As String, flag As Boolean, adr As String
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim svar As Integer
'Stop
    Application.ScreenUpdating = False
   
    If flag = False Then
        vareNr = Target
        adr = Target.Address
        arkNavn = ActiveSheet.Name
    End If
   
    For arkNr = 1 To ActiveWorkbook.Sheets.Count
        If flag = False And Target <> "" Then
            Sheets(arkNr).Activate
            antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
            antalKolonner = ActiveCell.SpecialCells(xlLastCell).Column
           
            dubLetAdresse = findesDublet
            If ActiveSheet.Name = "Ark1" And Target.Address = "$AI$1" Then
                Exit For
            Else
                If dubLetAdresse <> "" And dubLetAdresse <> adr Then
                    svar = MsgBox("Varenr. eksistere allerede i " & Sheets(arkNr).Name & ", vil du oprette alligevel?", vbOKCancel, "Dublet-test")
                    If svar = 1 Then
                        flag = True
                        ActiveSheet.Range(dubLetAdresse) = ""
                        flag = False
                        Exit For
                    Else
                        Target = ""
                    End If
                End If
            End If
        End If
    Next arkNr
   
    Sheets(arkNavn).Activate
End Sub
Private Function findesDublet()
    With Sheets(arkNr).Range(Cells(1, 1), Cells(antalRækker, antalKolonner))
        Set c = .Find(vareNr, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findesDublet = c.Address
        Else
            findesDublet = ""
        End If
    End With
End Function

Hej igen,
Vender som aftalt tilbage til dig.
Vi har været igennem en stor ændring på jobbet, så der går lige lidt længere tid nu.
Men jeg arbejder skam stadig på sagen og ville høre om du stadig laver lidt support/kurser i vba?

Velkommen "tilbage"
Svaret er ja til dit spørgsmål.

og det kunne nok også lade sig gøre endnu...