Add criteria to code = check whether if a textbox has been edited.

[Celticfc]

Hi all,

Code below simply updates all cells with values of the textbox/combobox. It doesn’t matter if I change the values or not, it will simply paste all 23 boxes again. This operation takes around 45 seconds as I have lots of formulations in over 30 pages linked to the database.

I need a code where, if a box hasn’t been edited, then there’s no point pasting it’s data again etc.

i.e

OPERATION 1) If textbox26 changed Then

ActiveCell.Offset(0, 0).Value = TextBox26.Value


OPERATION 2) if combobox19 changed Then

ActiveCell.Offset(0, -1).Value =
ComboBox19.Value

Etc.etc. The code should check for all 23 boxes and only paste boxes that have been edited.

This is the code:

Private Sub Submitbutton_Click()
    Dim FindString As String
    Dim Rng As Range
    FindString = Range("e11").Value
    If Trim(FindString) <> "" Then
        With Sheets("manager 1").Range("f:f")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.ScreenUpdating = False
                Application.Goto Rng, False
                ActiveCell.Offset(0, 0).Value = TextBox26.Value 'name
                ActiveCell.Offset(0, -5).Value = ComboBox19.Value 'store
                ActiveCell.Offset(0, -1).Value = TextBox24.Value 'position
                ActiveCell.Offset(0, 1).Value = TextBox23.Value 'hire date
                ActiveCell.Offset(0, 2).Value = TextBox22.Value 'current role start date
                ActiveCell.Offset(0, 3).Value = TextBox21.Value 'function start date
                ActiveCell.Offset(0, 4).Value = TextBox36.Value 'status
                ActiveCell.Offset(0, 5).Value = TextBox46.Value 'status start date
                ActiveCell.Offset(0, 6).Value = TextBox56.Value 'salary
                ActiveCell.Offset(0, 7).Value = TextBox66.Value 'review grade
                ActiveCell.Offset(0, 9).Value = TextBox76.Value 'ly review grade
                ActiveCell.Offset(0, 8).Value = TextBox86.Value 'potential scope
                ActiveCell.Offset(0, 10).Value = TextBox96.Value 'ly potential scope
                ActiveCell.Offset(0, 11).Value = TextBox12.Value 
                ActiveCell.Offset(0, 12).Value = TextBox13.Value 
                ActiveCell.Offset(0, 13).Value = TextBox14.Value 
                ActiveCell.Offset(0, 14).Value = TextBox15.Value 'mother tongue
                ActiveCell.Offset(0, 15).Value = TextBox16.Value 'additional lang 1
                ActiveCell.Offset(0, 16).Value = TextBox18.Value 'additional lang 2
                ActiveCell.Offset(0, 17).Value = TextBox19.Value 'additional lang 3
                ActiveCell.Offset(0, 18).Value = TextBox20.Value 'secondment
                ActiveCell.Offset(0, 19).Value = TextBox31.Value 'length of secondment
                ActiveCell.Offset(0, 20).Value = TextBox32.Value 'relocation 1
                ActiveCell.Offset(0, 21).Value = TextBox33.Value 'relocation 2
                ActiveCell.Offset(0, 22).Value = TextBox43.Value 
                ActiveCell.Offset(0, 23).Value = TextBox54.Value 
                Sheets("One-Pager Profile").Select
                Range("A1").Select
                Unload Me
                'MsgBox "Comment Saved"
                            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
     
   
End Sub

 

[dmt32]

Hi,
you can do what you want but perhaps maybe just turning events off & avoid using select could speed your code up


Untested but see if this update to your code works any faster:

Private Sub Submitbutton_Click()
    Dim FindString As String
    Dim Rng As Range
    
    
    FindString = Range("e11").Value
    
    If Trim(FindString) = "" Then Exit Sub
    
'manage errors
    On Error GoTo ExitSub
    
'search range
        Set Rng = Sheets("manager 1").Columns(6).Find(What:=FindString, LookIn:=xlValues, _
                                                        LookAt:=xlWhole, SearchOrder:=xlByRows, _
                                                        SearchDirection:=xlNext, MatchCase:=False)
        If Not Rng Is Nothing Then
'turn events off
            With Application
                .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual
            End With
'add data to worksheet
            Rng.Value = TextBox26.Value 'name
            Rng.Offset(0, -5).Value = ComboBox19.Value 'store
            Rng.Offset(0, -1).Value = TextBox24.Value 'position
            Rng.Offset(0, 1).Value = TextBox23.Value 'hire date
            Rng.Offset(0, 2).Value = TextBox22.Value 'current role start date
            Rng.Offset(0, 3).Value = TextBox21.Value 'function start date
            Rng.Offset(0, 4).Value = TextBox36.Value 'status
            Rng.Offset(0, 5).Value = TextBox46.Value 'status start date
            Rng.Offset(0, 6).Value = TextBox56.Value 'salary
            Rng.Offset(0, 7).Value = TextBox66.Value 'review grade
            Rng.Offset(0, 9).Value = TextBox76.Value 'ly review grade
            Rng.Offset(0, 8).Value = TextBox86.Value 'potential scope
            Rng.Offset(0, 10).Value = TextBox96.Value 'ly potential scope
            Rng.Offset(0, 11).Value = TextBox12.Value
            Rng.Offset(0, 12).Value = TextBox13.Value
            Rng.Offset(0, 13).Value = TextBox14.Value
            Rng.Offset(0, 14).Value = TextBox15.Value 'mother tongue
            Rng.Offset(0, 15).Value = TextBox16.Value 'additional lang 1
            Rng.Offset(0, 16).Value = TextBox18.Value 'additional lang 2
            Rng.Offset(0, 17).Value = TextBox19.Value 'additional lang 3
            Rng.Offset(0, 18).Value = TextBox20.Value 'secondment
            Rng.Offset(0, 19).Value = TextBox31.Value 'length of secondment
            Rng.Offset(0, 20).Value = TextBox32.Value 'relocation 1
            Rng.Offset(0, 21).Value = TextBox33.Value 'relocation 2
            Rng.Offset(0, 22).Value = TextBox43.Value
            Rng.Offset(0, 23).Value = TextBox54.Value
'inform user
            'MsgBox "Comment Saved",64, "Record Saved"
        End If
   
ExitSub:
'turn events on
With Application
    .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic
End With


If Err > 0 Then
'report errors
    MsgBox (Error(Err)), 48, "Error"
Else
'close form
    If Not Rng Is Nothing Then
        Unload Me
    Else
'inform user
        MsgBox "Nothing found", 64, "Not Found"
    End If
End If
End Sub

Dave

 

[Celticfc]

Hi Dave,

Thank you, it has certainly speeded up the process.

Is there a way, for us to check, whether if text box value is same as range value, if so, we can skip pasting, if not then paste it. This way, we won't have to update ranges that have the same values.

i.e.

Rng.Offset(0, -5).Value = ComboBox19.Value 'store

if offset (0,5) IS SAME AS combobox19.value, then skip.

and repeat for rest of the ranges etc.

Also, what is the function of:

Rng.Offset(0, -5).Value = ComboBox19.Value 'store

Thank you for all your help.

 

[dmt32]

Hi,
untested but see if following update does what you want:

Private Sub Submitbutton_Click()
    Dim FindString As String
    Dim Rng As Range
    Dim i As Integer
    Dim BoxValue As Variant
    
    
    FindString = Range("e11").Value
    
    If Trim(FindString) = "" Then Exit Sub
    
'manage errors
    On Error GoTo ExitSub
    
'search range
    Set Rng = Sheets("manager 1").Columns(6).Find(what:=FindString, LookIn:=xlValues, _
    lookat:=xlWhole, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False)
    If Not Rng Is Nothing Then
        
'turn events off
        With Application
            .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual
        End With
'add data to worksheet
        With Rng
            For i = 1 To 3
                BoxValue = Me.Controls("TextBox" & Choose(i, 26, 19, 24)).Value
                With .Offset(0, Choose(i, 0, -5, -1))
'update range only if value has changed
                    If .Value <> BoxValue Then .Value = BoxValue
                End With
            Next i
            
            For i = 1 To 23
                BoxValue = Me.Controls("TextBox" & Choose(i, 23, 22, 21, 36, 46, 56, 66, 76, 86, 96, 12, 13, _
                                                                 14, 15, 16, 18, 19, 20, 31, 32, 33, 43, 54)).Value
                With .Offset(0, i)
'update range only if value has changed
                    If .Value <> BoxValue Then .Value = BoxValue
                End With
            Next i
        End With
            
'inform user
        'MsgBox "Comment Saved",64, "Record Saved"
        End If
        
ExitSub:
'turn events on
        With Application
            .Calculation = xlCalculationAutomatic
            .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic
        End With
        
        If Err > 0 Then
'report errors
            MsgBox (Error(Err)), 48, "Error"
        Else
'close form
            If Not Rng Is Nothing Then
                Unload Me
            Else
'inform user
                MsgBox "Nothing found", 64, "Not Found"
            End If
        End If
End Sub

Dave