1

I copy data from "database" and paste it to another sheet.
Macro takes the names from the list in Sheet1 and looks for matches in Sheet2.
When the match is found it is copying a specific cell.

I have a macro for each person on the list so I have five macros doing the same thing so maybe that why it takes so much time (around three minutes).

Is there any way to make it faster?

Sub CopySalesMan1()
    
    Dim lastrow As Long, erow As Long
    
    lastrow = Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row
    
    For i = 2 To lastrow
    
        If Worksheets("Sheet2").Cells(i, 25).Value = Worksheets("Sheet1").Cells(6, 12).Value Then
    
            Worksheets("Sheet2").Cells(i, 2).Copy
    
            erow = Worksheets("Sheet1").Cells(Rows.Count, 4).End(xlUp).Row
    
            Worksheets("Sheet1").Cells(erow + 1, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False
    
            Worksheets("Sheet2").Cells(i, 25).Copy
    
            Worksheets("Sheet1").Cells(erow + 1, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False
        
            Worksheets("Sheet2").Cells(i, 3).Copy
    
            Worksheets("Sheet1").Cells(erow + 1, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False
        
            Worksheets("Sheet2").Cells(i, 4).Copy
    
            Worksheets("Sheet1").Cells(erow + 1, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False
              
            Worksheets("Sheet2").Cells(i, 5).Copy
    
            Worksheets("Sheet1").Cells(erow + 1, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False
            
            Worksheets("Sheet2").Cells(i, 6).Copy
    
            Worksheets("Sheet1").Cells(erow + 1, 8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False
            
            Worksheets("Sheet2").Cells(i, 21).Copy
    
            Worksheets("Sheet1").Cells(erow + 1, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False
    
        End If
    
    Next i
    
End Sub

And the macro calling for every salesman in the list

Sub All()
    
    If Worksheets("Sheet1").Range("L7").Value <> "" Then Call CopySalesMan2
    If Worksheets("Sheet1").Range("L8").Value <> "" Then Call CopySalesMan3
    If Worksheets("Sheet1").Range("L9").Value <> "" Then Call CopySalesMan4
    If Worksheets("Sheet1").Range("L10").Value <> "" Then Call CopySalesMan5
    
End Sub

Sheet1
Sheet1

Sheet2 (database)
Sheet2 (database)

Community
  • 1
  • 1
Timonek
  • 323
  • 2
  • 9
  • 2
    If your code works, but you just want to improve it, then your question is better suited for Code Review: https://codereview.stackexchange.com/ – braX Jan 15 '21 at 04:02
  • But to answer your question, you dont need to use Copy/Paste functions that are slow. You can assign values directly to cells instead. There are many better way to do this, but again, you can go thru them with someone at Code Review. – braX Jan 15 '21 at 04:04
  • Since you just want values do `.value = .value` instead of copying then pasting. – Simon Jan 15 '21 at 04:04
  • 1
    thanks a lot! I didn't know about code review! – Timonek Jan 15 '21 at 04:34
  • 2
    @braX: It is on topic for both sites. You may want to see [Please stop redirecting performance problems to Code Review](https://meta.stackoverflow.com/questions/388864/please-stop-redirecting-performance-problems-to-code-review) and [Performance question - Stack Overflow or Code Review?](https://meta.stackoverflow.com/questions/300981/performance-question-stack-overflow-or-code-review) and [Guidance on migrating questions to Code Review](https://meta.stackoverflow.com/questions/348395/guidance-on-migrating-questions-to-code-review) – Siddharth Rout Jan 15 '21 at 06:11
  • Even I used to think that but was later corrected. If you have enough reputation then you will be able to see the [question](https://meta.stackoverflow.com/questions/390803/is-this-question-on-topic-for-code-review) that I had asked (now deleted) – Siddharth Rout Jan 15 '21 at 06:11

1 Answers1

2

I got the solution:

as braX said .value = .value will be better option

Sub CopySalesMan()
Application.ScreenUpdating = False
Dim XlWkSht As Worksheet, sVal As String, lRow As Long, i As Long, r As Long
Set XlWkSht = Worksheets("Sheet1")
lRow = XlWkSht.Range("D" & XlWkSht.Rows.Count).End(xlUp).Row
For i = 6 To 10
  If XlWkSht.Range("L" & i).Value <> "" Then
     sVal = XlWkSht.Range("L" & i).Value
    With Worksheets("Sheet2")
      For r = 2 To .Range("B" & .Rows.Count).End(xlUp).Row
        If .Range("Y" & r).Value2 = sVal Then
          lRow = lRow + 1
          XlWkSht.Range("B" & lRow).Value = .Range("B" & r).Value
          XlWkSht.Range("C" & lRow).Value = .Range("Y" & r).Value
          XlWkSht.Range("D" & lRow).Value = .Range("C" & r).Value
          XlWkSht.Range("E" & lRow).Value = .Range("D" & r).Value
          XlWkSht.Range("F" & lRow).Value = .Range("E" & r).Value
          XlWkSht.Range("G" & lRow).Value = .Range("F" & r).Value
          XlWkSht.Range("H" & lRow).Value = .Range("U" & r).Value
        End If
      Next r
    End With
  End If
Next
Application.ScreenUpdating = True
End Sub
Timonek
  • 323
  • 2
  • 9
  • Avoid the use of `.Text`. You may want to see [What is the difference between .text, .value, and .value2?](https://stackoverflow.com/questions/17359835/what-is-the-difference-between-text-value-and-value2) – Siddharth Rout Jan 15 '21 at 08:11
  • @SiddharthRout so you suggest I should change `.text` to `.value2` ? – Timonek Jan 15 '21 at 08:26