Hello brothers and sisters. Below is my code for copy paste from 3rd party software and calculate the weight of product. But it runs a little slow. It takes 7 sec for running just a few lines of code.
Are there methods for make it faster? Thanks in advanced!
Are there methods for make it faster? Thanks in advanced!
VBA Code:
Sub Sumweight()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Dim wb As Workbook
Dim erow As Long
Dim a As Range
Set wb = ActiveWorkbook
Set s1 = wb.Sheets("Sheet1")
Set s2 = wb.Sheets("Sheet2")
Set s3 = wb.Sheets("Sheet3")
s1.Range("A1:W200").ClearContents
s2.Range("A1:E20").ClearContents
'Work with Sheet1
Set a = s1.Cells(1, 1)
s1.Activate
a.Activate
s1.PasteSpecial Format:="Unicode Text"
'Work with Sheet2
s2.Activate
s2.Range("A:A").Value = s1.Range("Q:Q").Value
s2.Range("B:B").Value = s1.Range("J:J").Value
s2.Range("C:C").Value = s1.Range("S:S").Value
s2.UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
For Each cel In s2.Range("B2:B20")
If InStr(1, "k", cel.Value) Or InStr(1, "", cel.Value) Then
cel.EntireRow.Delete
End If
Next
For Each cel1 In s2.Range("A2:A20")
If InStr(1, "Ô tô", cel1.Value) Then
cel1.EntireRow.Delete
End If
Next
Lr1 = s1.Range("A" & Rows.Count).End(xlUp).Row
Lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
Set hdt = s2.Range("D2:D" & Range("A" & Rows.Count).End(xlUp).Row)
s2.Range("D2:D" & Lr2).Formula = "=SUMIFS(Sheet1!$I$2:$I$" & Lr1 & ",Sheet1!$Q$2:$Q$" & Lr1 & ",A2,Sheet1!$J$2:$J$" & Lr1 & ",B2,Sheet1!$S$2:$S$" & Lr1 & ",C2)"
For Each c In hdt
c.Value = c.Value
Next
'Creat droplist in Sheet3
s2.Range("E:E").Value = s2.Range("A:A").Value
s2.Range("E:E").RemoveDuplicates Columns:=1, Header:=xlYes
erow = s2.Range("E2").End(xlDown).Row
Set rngList = s2.Range("E2", "E" & erow)
wb.Names.Add Name:="List1", RefersTo:=rngList
s3.Range("B2").Validation.Delete
s3.Range("B2").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=List1"
s3.Activate
End Sub