Gem kun ændringer ikke hele rækken

Du kunne måske logge det, du læser ind i userformen i userform.initialize ved hjælp af variabler (eller et array). Når brugeren opdaterer, sammenligner du oplysningerne fra formen med dine variabler. Hvis der er forskel, logger du og opdaterer det pågældende felt - ellers lader du koden fortsætte. Erklær variablerne i toppen uden for funktionen.

Kan du give et eksempel i VBA ?

Koden skal ligge i selve userformen. Jeg forudsætter, at data bilver læst ind i tre tekstbokse - tbxFirstName, tbxLastName og tbxPhone samt en knap btnOK.


Option Explicit

Dim FirstName As String
Dim LastName As String
Dim Phone As String


Private Sub UserForm_Initialize()
' Jeg går ud fra, at du allerede har noget kode, der indlæser data
' til din userform

  FirstName = Range("a1")
  tbxFirstName = FirstName

  LastName = Range("a2")
  tbxLastName = LastName
 
  Phone = Range("a3")
  tbxPhone = Phone
 
End Sub

Private Sub btnOK_Click()
  Me.Hide
  If Not FirstName = tbxFirstName Then
    Range("a1") = tbxFirstName
    ' udfyld din log herfra
  End If
  If Not LastName = tbxLastName Then
    Range("a2") = tbxLastName
    ' udfyld din log herfra
  End If
  If Not Phone = tbxPhone Then
    Range("a3") = tbxPhone
    ' udfyld din log herfra
  End If
End Sub

Selve indlæsningen foregår ved hjælp af følgende :

Private Sub UserForm_Initialize()
Dim sPrompt As String
Dim ws As Worksheet

Set ws = Worksheets("tblData")
   
    If frmMainMenu.ListNames.ListIndex > -1 Then
        sPrompt = frmMainMenu.ListNames.Value
    End If
   
    Cells.Find(What:=sPrompt, After:=Range("A2"), LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Activate
    Range("A" & ActiveCell.Row & ":A" & ActiveCell.Row).EntireRow.Select

    txtFirstName.ControlSource = "$C$" & ActiveCell.Row
    txtLastName.ControlSource = "$D$" & ActiveCell.Row
    txtAddress1.ControlSource = "$F$" & ActiveCell.Row
    txtAddress2.ControlSource = "$G$" & ActiveCell.Row
    txtCity.ControlSource = "$H$" & ActiveCell.Row
    txtZip.ControlSource = "$I$" & ActiveCell.Row
    txtCountry.ControlSource = "$J$" & ActiveCell.Row
   
End Sub

Den er vel ok ?

Jeg tror ikke helt dit forslag virker efter hensigten :-(

Det er jo ikke loggen jeg foretager ændringerne i ... loggen skrives automatisk ved ændring i de enkelte felter i tblData, så jeg kan ikke lige se hvordan din kode kan det ...

Programkoden

Cells.Find(What:=sPrompt, After:=Range("A2"), LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Activate
    Range("A" & ActiveCell.Row & ":A" & ActiveCell.Row).EntireRow.Select

indlæser hele rækken i UserForm, men jeg er kun interesseret i at gemme de steder i rækken hvor der reelt er ændret med min save funktion, altså jeg skal skrive tilbage til samme række. På baggrund af dette opdateres min log automatisk

Hvordan gemmer du til log?

Hensigten med mit forslag er, at registrere input til formularen for at kunne sammenligne med brugerens ændringer inden skrivning til log.

Hvis du laver globale variabler for de værdier, du indlæser til dine txt bokse og sætter værdien under indlæsningen, så har du styr på dine "før" data.

F.eks. en variabel FirstName
Firstname = "$C$" & ActiveCell.Row

derefter indlæsning til din tekstboks
txtFirstName.ControlSource = "$C$" & ActiveCell.Row

Når du så gemmer til log, laver du en kontrol på, hvad der er tastet i formularen (tbxFirstName) holdt op mod variablen (FirstName). Hvis der er forskel, skal du skrive til loggen - ellers ikke.

Måske er det i virkeligheden metoden i log scriptet der er problemet. Jeg får jo en ændret række, men kan altså ikke rigtigt se hvad ændringen består af :-(


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = "Log" Then Exit Sub
   
    Application.EnableEvents = False
    On Error Resume Next
    With Sheets("Log").Cells(Rows.Count, 1).End(xlUp)
       
        .Offset(1, 0).Value = Environ("UserName")
        .Offset(1, 1) = Sh.Name
        .Offset(1, 2) = Target.Address
        .Offset(1, 3) = "'" & Target.Formula
        .Offset(1, 4) = Previous
        Previous = ""
        .Offset(1, 5) = Now
    End With
    Application.EnableEvents = True

End Sub

Initialiseringen af userformen ser ok ud, og dit logscript virker også, som det skal. Problemet ligger nok i, hvordan du skriver ændringerne tilbage til Excel. Hvis du skriver samtlige tbx fra formularen tilbage til Excel, vil Excel opfatte dem alle som ændring uanset om teksten rent faktisk har ændret sig.

1) Registrer "før" værdien i UserForm_Initialize (FileName som global variabel)
2) Ved OK tryk check om der er ændret (Er værdi i tbx <> FileName)
3) Hvis ændret skriv til den pågældende celle
4) Din log opdaterer automatisk via Workbook_SheetChange

Se koden i stærkt forenklet form.

Dim FirstName as string

Private Sub UserForm_Initialize()
  FileName = "$C$" & ActiveCell.Row
  txtFirstName.ControlSource = Filename
End Sub

Private Sub btnOK_Click()
  If Not FirstName = txtFirstName.ControlSource Then   
    "$C$" & ActiveCell.Row = txtFirstName.ControlSource
End Sub

Skal lige se om jeg har forstået:

Step1: Ark med rækker med info loades i form.
Step2: Bruger ændrer info i form og trykker gem.
Step3: Rækken opdateres med ny data og log skrives.

Problem: der differentieres ikke mellem gammel og ny data så log bliver mere eller mindre bare en kopi af rækkeark.

Er det korrekt forstået?

En løsning der tager udgangspunkt en userform med en knap hvor man trykker "gem ændringer" for at gemme sine ændringer:

Private Sub CommandButton2_Click()

Dim info As Worksheet
Dim log As Worksheet
Set info = ThisWorkbook.Worksheets("Række")
Set log = ThisWorkbook.Worksheets("Log")

temp_id_info = UserForm1.ID.Value
temp_row_info = info.Range("A:A").Find(What:=temp_id_info, After:=info.Range("A1"), LookIn:=xlFormulas, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row


temp_id_log = UserForm1.ID_Version
temp_row_log = log.Range("C:C").Find(What:=temp_id_log, After:=Range("C1"), LookIn:=xlFormulas, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row + 1

log.Rows(temp_row_log & ":" & temp_row_log).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

log.Range("A" & temp_row_log) = log.Range("A" & temp_row_log - 1)
log.Range("B" & temp_row_log) = log.Range("B" & temp_row_log - 1) + 1
log.Range("C" & temp_row_log) = log.Range("A" & temp_row_log) & "_" & log.Range("B" & temp_row_log)
log.Range("D" & temp_row_log) = log.Range("D" & temp_row_log - 1)
log.Range("E" & temp_row_log) = UserForm1.Fname.Value
log.Range("F" & temp_row_log) = UserForm1.Lname.Value
log.Range("G" & temp_row_log) = UserForm1.Phone.Value

i = 2
change_str = Now() & " //// "
change_count = 0
Do While info.Cells(temp_row_info, i) <> ""
   
    If log.Cells(temp_row_log, i) <> log.Cells(temp_row_log - 1, i) Then
        info.Cells(temp_row_info, i) = log.Cells(temp_row_log, i)
        log.Cells(temp_row_log, i).Interior.ColorIndex = 3
        change_str = change_str + "Ændring i kolonne " & i & ": " & log.Cells(temp_row_log, i) & " //// "
    End If
    i = i + 1
Loop
log.Cells(temp_row_log, i) = change_str

End Sub

Jeg har givet hver medarbejderrække et ID og et versionsnummer og en kombination heraf for mere effektiv søgning.

I loggen indsætter jeg en linie som den sidste linie til det pågældende ID og skriver versionsnummeret op med 1, markerer ændrede felter med rødt og skriver en logændring med et timestamp.

Sig til hvis du gerne vil have arket med hele løsningen i.

En løsning der tager udgangspunkt en userform med en knap hvor man trykker "gem ændringer" for at gemme sine ændringer:

Private Sub CommandButton2_Click()

Dim info As Worksheet
Dim log As Worksheet
Set info = ThisWorkbook.Worksheets("Række")
Set log = ThisWorkbook.Worksheets("Log")

temp_id_info = UserForm1.ID.Value
temp_row_info = info.Range("A:A").Find(What:=temp_id_info, After:=info.Range("A1"), LookIn:=xlFormulas, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row


temp_id_log = UserForm1.ID_Version
temp_row_log = log.Range("C:C").Find(What:=temp_id_log, After:=Range("C1"), LookIn:=xlFormulas, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row + 1

log.Rows(temp_row_log & ":" & temp_row_log).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

log.Range("A" & temp_row_log) = log.Range("A" & temp_row_log - 1)
log.Range("B" & temp_row_log) = log.Range("B" & temp_row_log - 1) + 1
log.Range("C" & temp_row_log) = log.Range("A" & temp_row_log) & "_" & log.Range("B" & temp_row_log)
log.Range("D" & temp_row_log) = log.Range("D" & temp_row_log - 1)
log.Range("E" & temp_row_log) = UserForm1.Fname.Value
log.Range("F" & temp_row_log) = UserForm1.Lname.Value
log.Range("G" & temp_row_log) = UserForm1.Phone.Value

i = 2
change_str = Now() & " //// "
change_count = 0
Do While info.Cells(temp_row_info, i) <> ""
   
    If log.Cells(temp_row_log, i) <> log.Cells(temp_row_log - 1, i) Then
        info.Cells(temp_row_info, i) = log.Cells(temp_row_log, i)
        log.Cells(temp_row_log, i).Interior.ColorIndex = 3
        change_str = change_str + "Ændring i kolonne " & i & ": " & log.Cells(temp_row_log, i) & " //// "
    End If
    i = i + 1
Loop
log.Cells(temp_row_log, i) = change_str

End Sub

Jeg har givet hver medarbejderrække et ID og et versionsnummer og en kombination heraf for mere effektiv søgning.

I loggen indsætter jeg en linie som den sidste linie til det pågældende ID og skriver versionsnummeret op med 1, markerer ændrede felter med rødt og skriver en logændring med et timestamp.

Sig til hvis du gerne vil have arket med hele løsningen i.

Lige en update ... jeg har været på forretningsrejse i weekenden, derfor først respons nu

Tryphon > jeg har samme problem når jeg benytter dit forslag, Log rutinen opdaterer ikke som tiltænkt :-( .... dvs. jeg kan se der er sket en ændring, men "Previous" fremstår blankt som ved indtastning af en helt ny post :-(

Det ser umiddelbart ud som om rutine udelukkende virker korrekt, hvis indtastningen foretages direkte i min tabel/regneark, og ikke via en userform.

iver_mo > jeg afprøver din version i løbet af dagen

iver_mo > vil gerne se din løsning

mail :  lasse.jensen@novasol.com

På forhånd tak

Dit problem ligger i din worksheet_change funktion. Du bruger previous forkert. Den læser simpelthen ikke fra-værdien.

Skriv direkte til loggen, som foreslået i #3 i stedet for at bruge Worksheet_Change funktonen. Nedenstående kode forudsætter, at du står i det ark, der indeholder dine data.

Dim FirstName As String
dim col as integer
dim row as long

Private Sub UserForm_Initialize()
  row = ActiveCell.row 
  col = 3 ' col = kolonne for FirstName i activesheet
  FirstName = cells(row, col)
  tbxFirstName = FirstName
End Sub

Private Sub btnOK_Click()
  Me.Hide
  If Not FirstName = tbxFirstName Then
    Range("a1") = tbxFirstName ' Overskriv gammel værdi med ny værdi
' Skriv til log
  With Sheets("Log").cells(rows.count,1),end(xlup)
    .Offset(1, 0).Value = Environ("UserName")
    .Offset(1, 1) = Activesheet.name
    .offset(1, 2) = Range(Cells(row, col), Cells(row, col)).Address
    .Offset(1, 3) = tbxFirstName
    .Offset(1, 4) = firstname
    .Offset(1, 5) = Now
  End With
  End If
End Sub

Resten af felterne skal naturligvis skrives ind i denne funktion for at få det hele til at stå på samme linje.

Ovenstående skrevet lidt ud af hovedet, så det kan være, du skal rette en lille smule til for at få det til at virke.

iver_mo har hjulpet mig førdig med løsningen ( dybt taknemmelig ), men Tryphon har også været til god inspiration, så jeg vil gerne fordele point til jer begge ...

Tryphon placet et svar :-)

Hej Jensen

Bare for at stille min nysgerrighed. Hvad blev løsningen?

Det var som du også påpegede log rutinen som ikke var helt velegnet til fremgangsmåden med at rette oplysninger via en user form, så det er reelt en helt ny ( og forbedret ) log rutine jeg har fået indarbejdet i modellen