Hent værdi ud fra id-nr

Option Explicit
Option Base 1

Public r As Long
Public c As Range, n As Range
Public rngIdNr As Range
Public rngHentIdNr As Range
Public vdB() As Variant

Public Sub DataTilID()
   
    vdB = Worksheets("Hent").Range("C20:Q20").Value
    With Worksheets("ID")
      r = .Cells(Rows.Count, 2).End(xlUp).Row + 1
      .Cells(r, 2).Resize(1, 15).Value = vdB
      ReDim vdB(1)
      vdB(1) = .Cells(r - 1, 1).Value + 10
      .Cells(r, 1).Value = vdB
      Set rngIdNr = Range(.Cells(2, 1), .Cells(r, 1))
    End With
   
    With Worksheets("Hent")
      .Range("B7").Value = vdB
      Set rngHentIdNr = .Range("B37:B42,B50:B55")
    End With
       
    For Each n In rngHentIdNr
      For Each c In rngIdNr
      If n.Value = c.Value Then
        vdB = c.Offset(, 1).Resize(1, 15).Value
        n.Offset(, 1).Resize(1, 15).Value = vdB
      End If
      Next
    Next
   
    Set rngIdNr = Nothing
    Set rngHentIdNr = Nothing
End Sub

Kan man dele den i 2 så man har en som adder og en som henter id!?

den som adder skal fjerne den værdi som man lige har addet i "hent" men gøre som den gør nu bare ikke hente id til B37:B42;osv det ville være lækkert hvis det var en knap for sig selv....

Hvis man også kunne lave en som søgte efter en værdi på id
hvis man skriver i C25 og trykker på en knap søger den og hvis den finder den værdi på id skal den ud for den række værdien er hente det id nr og smide deet i B25. :D

kan vi sikkert fikse. dette er rekkefølgen nå

1) legger data fra Worksheets("Hent").Range("C20:Q20")
    til siste rad i Worksheets("ID")

2)  oppretter nytt id-nr til siste rad

3)  setter inn det nye id-nummer i Worksheets("Hent").B7

4) sjekker om det er like id nr i
    range  "hent".Range("B37:B42,B50:B55")
    og i "id"range.Range(.Cells(2, 1), .Cells(r, 1))

5) flytter data til hent hvis like id

Hvor skal vi lage skille? mellom 3 og 4?

1,2,3=1
4,5=2
så når man adder en ny henter den ikke før man selv trykker...

Option Explicit
Option Base 1

Public r As Long
Public c As Range, n As Range
Public rngIdNr As Range
Public rngHentIdNr As Range
Public vdB() As Variant

Public Sub DataTilID()

    vdB = Worksheets("Hent").Range("C20:Q20").Value

    With Worksheets("ID")
      r = .Cells(Rows.Count, 2).End(xlUp).Row + 1
      .Cells(r, 2).Resize(1, 15).Value = vdB
      ReDim vdB(1)
      vdB(1) = .Cells(r - 1, 1).Value + 10
      .Cells(r, 1).Value = vdB
    End With

    Worksheets("Hent").Range("B7").Value = vdB

End Sub

Public Sub DataTilHent()
 
  Set rngHentIdNr = Worksheets("Hent").Range("B37:B42,B50:B55")
 
  With Worksheets("ID")
    r = .Cells(Rows.Count, 2).End(xlUp).Row
    Set rngIdNr = Range(.Cells(2, 1), .Cells(r, 1))
  End With

    For Each n In rngHentIdNr
      For Each c In rngIdNr
      If n.Value = c.Value Then
        vdB = c.Offset(, 1).Resize(1, 15).Value
        n.Offset(, 1).Resize(1, 15).Value = vdB
      End If
      Next
    Next

    Set rngIdNr = Nothing
    Set rngHentIdNr = Nothing
End Sub

da håer jeg denne fungerer og ønsker god weekend :-)

Public Sub HentIdNr()
 
  Set n = Worksheets("Hent").Range("C25")
 
  With Worksheets("ID")
    r = .Cells(Rows.Count, 2).End(xlUp).Row
    Set rngIdNr = Range(.Cells(2, 2), .Cells(r, 16))
  End With
   
  For Each c In rngIdNr
    If n.Value = c.Value Then
      n.Offset(, -1).Value = c.Offset(, 1 - c.Column).Value
    End If
  Next
 
Set n = Nothing
Set rngIdNr = Nothing
   
End Sub

Virker mange tak...

Og god weekend til dig... :D

den add funktion mangler kun at tømme C20:Q20 efter den har addet

Hvis man kan få søgningen til at finde værdi i cellen om teksten er 2 delt el ej...

Public Sub DataTilID()
    With Worksheets("Hent").Range("C20:Q20")
    vdB = .Value
    .ClearContents
    End With
   
    With Worksheets("ID")
      r = .Cells(Rows.Count, 2).End(xlUp).Row + 1
      .Cells(r, 2).Resize(1, 15).Value = vdB
      ReDim vdB(1)
      vdB(1) = .Cells(r - 1, 1).Value + 10
      .Cells(r, 1).Value = vdB
    End With

    Worksheets("Hent").Range("B7").Value = vdB

End Sub

vedr : ...teksten er 2 delt el ej...
dette bør ikke være noe problem, men har ikke tid lige nu
regner med at det kun er teksten i ID arket som kan være splittet?

Det er mere hvis man har en celle F.eks "john hansen" og man søger på "john" finder den en celle med john om det er "johnson" el "john hansen" det er bare for at man ikke skal skrive hele værdien...

Public Sub HentIdNr()
  Dim sInit As String
  Set n = Worksheets("Hent").Range("C25")
  n.Offset(, -1).ClearContents
  sInit = UCase(n.Text)
 
  With Worksheets("ID")
    r = .Cells(Rows.Count, 2).End(xlUp).Row
    Set rngIdNr = Range(.Cells(2, 2), .Cells(r, 16))
  End With
   
  For Each c In rngIdNr
    If Left(UCase(c.Value), Len(sInit)) = sInit Then
      If Not IsEmpty(n.Offset(, -1)) Then
        MsgBox "Flere verdier matcher, neste er :" & c.Text
      End If
      n.Value = c.Text
      n.Offset(, -1).Value = c.Offset(, 1 - c.Column).Value
    End If
  Next
 
Set n = Nothing
Set rngIdNr = Nothing
   
End Sub

Jep endnu et Problem Løst.. Mange tak igen... kom med et svar... :D

:D

Den du har lavet med ht kan man gøre sådan så der kan være flere!? som gør som ht bare 402 403 405 FH BS osv!?

skal være en grei sak, ser på det i ettermiddag

bare helt oki...