Simplify my working code please

[ipbr21054]

Ive now finished with my project & the below is the final code.
Can it be simplfied to run faster / smoother.
Thanks

Private Sub AddKeyToTableList_Click()
Dim response As Integer
Dim oNewRow As ListRow
' ADD NEW KEY TYPE TO TABLE
With Sheets("INFO").ListObjects("Table38")
  If IsError(Application.Match(Me.TextBox3.Value, .ListColumns(1).DataBodyRange.Value, 0)) Then
    Set oNewRow = .ListRows.Add
    oNewRow.Range.Cells(1) = Me.TextBox3.Value
    
    .Sort.SortFields.Clear
    .Sort.SortFields.Add KEY:=.ListColumns(1).Range, SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    With .Sort
         .Header = xlYes
         .Apply

    End With
    Application.Goto (.HeaderRowRange.Cells(1))
    Sheets("INV").Select                         'RELOAD INV WORKSHEET
    Me.ComboBox1.Value = Me.TextBox3.Value
    WillContinueSoon.Show
  Else
    MsgBox Me.TextBox3.Value & " KEY TYPE ALRADY EXISTS", vbInformation, "KEY TYPE EXISTS MESSAGE"
  End If
End With
ThisWorkbook.Worksheets("INV").Range("G22") = Me.TextBox1.Text ' BITING SENT TO WORKSHEET CELL G22
ThisWorkbook.Worksheets("INV").Range("G23") = Me.ComboBox1.Text ' KEY TYPE USED SENT TO WORKSHEET CELL G23
Dim wb As Workbook
        Set wb = Workbooks.Open(fileName:="C:\Users\Ian\Desktop\REMOTES ETC\DR\EXCEL WORKSHEETS\MOTORCYCLES.xlsm")
        
        Workbooks("MOTORCYCLES.xlsm").Sheets("INVOICES").Activate
        
        ActiveSheet.Rows("3").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
              
        Workbooks("DR.xlsm").Sheets("INV").Range("G13").Copy ' CUSTOMERS NAME
        wb.Sheets("INVOICES").Range("A3").PasteSpecial xlPasteValues
        
        Workbooks("DR.xlsm").Sheets("INV").Range("L16").Copy ' FRAME NUMBER
        wb.Sheets("INVOICES").Range("B3").PasteSpecial xlPasteValues
        
        Workbooks("DR.xlsm").Sheets("INV").Range("L15").Copy ' REGISTRATION
        wb.Sheets("INVOICES").Range("C3").PasteSpecial xlPasteValues
        
        Workbooks("DR.xlsm").Sheets("INV").Range("G22").Copy ' BITING
        wb.Sheets("INVOICES").Range("D3").PasteSpecial xlPasteValues
            
        Workbooks("DR.xlsm").Sheets("INV").Range("G23").Copy ' TYPE OF KEY
        wb.Sheets("INVOICES").Range("E3").PasteSpecial xlPasteValues
        
        Workbooks("DR.xlsm").Sheets("INV").Range("L13").Copy ' DATE OF JOB
        wb.Sheets("INVOICES").Range("F3").PasteSpecial xlPasteValues
            
        Workbooks("DR.xlsm").Sheets("INV").Range("L4").Copy ' INVOICE NUMBER
        wb.Sheets("INVOICES").Range("G3").PasteSpecial xlPasteValues
                
Dim x As Long
        Application.ScreenUpdating = False
With Sheets("INVOICES")
If .AutoFilterMode Then .AutoFilterMode = False
        x = .Cells(.Rows.count, 2).End(xlUp).Row
            .Range("A1:G" & x).Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess
End With
        ActiveWorkbook.Save
        Application.ScreenUpdating = True
        Sheets("INVOICES").Range("A3").Select

        wb.Close True
        Application.CutCopyMode = False
        Unload Me
With ActiveSheet
        Range("D1").Select
End With
End Sub

 

[6StringJazzer]

First please explain why you think it is not fast or smooth enough.

Maybe move this line to the top

        Application.ScreenUpdating = False

Your copy/paste value operations can be simplified from this format

        Workbooks("DR.xlsm").Sheets("INV").Range("G13").Copy ' CUSTOMERS NAME
        wb.Sheets("INVOICES").Range("A3").PasteSpecial xlPasteValues

to this

        Workbooks("DR.xlsm").Sheets("INV").Range("G13").Value = wb.Sheets("INVOICES").Range("A3").Value

But you don't have that many of them so you may not notice a difference in performance.

 

[DanteAmor]

I simplified in some parts and removed some lines that are not necessary

If you set an object for the workbook or for the sheet, you no longer refer to the name of the workbook or sheet, instead use the variable. I put the variable Sh1 for the sheet "INV" and Sh2 for the sheet "INVOICES" and I always reference the variable.

If you have questions about anything, let me know.

Private Sub AddKeyToTableList_Click()
  Dim response As Integer
  Dim oNewRow As ListRow
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim wb As Workbook
  Dim x As Long

  Set sh1 = ThisWorkbook.Worksheets("INV")
  Application.ScreenUpdating = False
  
  ' ADD NEW KEY TYPE TO TABLE
  With Sheets("INFO").ListObjects("Table38")
    If IsError(Application.Match(Me.TextBox3.Value, .ListColumns(1).DataBodyRange.Value, 0)) Then
      Set oNewRow = .ListRows.Add
      oNewRow.Range.Cells(1) = Me.TextBox3.Value
      .Sort.SortFields.Clear
      .Sort.SortFields.Add Key:=.ListColumns(1).Range, SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortTextAsNumbers
      With .Sort
        .Header = xlYes
        .Apply
      End With
      
      Application.Goto (.HeaderRowRange.Cells(1))
      sh1.Select                         'RELOAD INV WORKSHEET
      Me.ComboBox1.Value = Me.TextBox3.Value
      WillContinueSoon.Show
    Else
      MsgBox Me.TextBox3.Value & " KEY TYPE ALRADY EXISTS", vbInformation, "KEY TYPE EXISTS MESSAGE"
    End If
  End With
  
  sh1.Range("G22") = Me.TextBox1.Text ' BITING SENT TO WORKSHEET CELL G22
  sh1.Range("G23") = Me.ComboBox1.Text ' KEY TYPE USED SENT TO WORKSHEET CELL G23
  
  Set wb = Workbooks.Open(Filename:="C:\Users\Ian\Desktop\REMOTES ETC\DR\EXCEL WORKSHEETS\MOTORCYCLES.xlsm")
  Set sh2 = wb.Sheets("INVOICES")
  
  sh2.Rows(3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
  
  sh2.Range("A3").Value = sh1.Range("G13").Value    ' CUSTOMERS NAME
  sh2.Range("B3").Value = sh1.Range("L16").Value    ' FRAME NUMBER
  sh2.Range("C3").Value = sh1.Range("L15").Value    ' REGISTRATION
  sh2.Range("D3").Value = sh1.Range("G22").Value    ' BITING
  sh2.Range("E3").Value = sh1.Range("G23").Value    ' TYPE OF KEY
  sh2.Range("F3").Value = sh1.Range("L13").Value    ' DATE OF JOB
  sh2.Range("G3").Value = sh1.Range("L4").Value     ' INVOICE NUMBER
  
  If sh2.AutoFilterMode Then sh2.AutoFilterMode = False
  x = sh2.Cells(Rows.Count, 2).End(xlUp).Row
  sh2.Range("A1:G" & x).Sort Key1:=sh2.Range("A3"), Order1:=xlAscending, Header:=xlGuess
  
  sh2.Range("A3").Select
  wb.Close True
  
  Application.ScreenUpdating = False

  Unload Me
  With ActiveSheet
    Range("D1").Select
  End With
End Sub

 

[ipbr21054]

Thanks,
I will take a look tomorrow.

I did try the advice in post #2 but it just pasted no values & cells were all blank.
Putting the code back how i had it before did it correctly

 

[MARK858]

Thanks,
I will take a look tomorrow.

I did try the advice in post #2 but it just pasted no values & cells were all blank.
Putting the code back how i had it before did it correctly

The line below in post 2 is the wrong way around

Workbooks("DR.xlsm").Sheets("INV").Range("G13").Value = wb.Sheets("INVOICES").Range("A3").Value

it should be

wb.Sheets("INVOICES").Range("A3").Value = Workbooks("DR.xlsm").Sheets("INV").Range("G13").Value

The equivalent is right in post 3

 

[6StringJazzer]

The line below in post 2 is the wrong way around

I'm so sorry about that. It's not the first time it's happened. I did not have a file to test.

 

[MARK858]

I'm so sorry about that. It's not the first time it's happened. I did not have a file to test.

It happens Jeff, we've all done it

 

[ipbr21054]

All done, Thanks for the replies.