0

I have this current code that copies and pastes values in a loop. It works fine, but it takes a long time to complete when there is a lot of data. I think there is a more efficient way to do this with .value, but I am needing some advice on how to implement.

Sub Looping() Dim OFFSETDOWN As String Dim OFFSETLEFT As String Dim OFFSETRITE As String Dim FILEDONE As String OFFSETDOWN = 1 OFFSETLEFT = 0 FILEDONE = "Calculate" Sheets("Emp Data").Select Range("E5").Select Application.CutCopyMode = False Selection.Copy Sheets("Results").Select Range("D1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Emp Data").Select Range("A10").Select ActiveCell.Offset(2, 0).Select Do Until FILEDONE = "" 'OFFSETDOWN = 0 'OFFSETLEFT = 0 'OFFSETRITE = 1 Application.CutCopyMode = False Selection.Copy Sheets("Results").Select Range("D2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Emp Data").Select ActiveCell.Offset(0, 1).Select Application.CutCopyMode = False Selection.Copy Sheets("Results").Select Range("D14").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Emp Data").Select ActiveCell.Offset(0, 4).Select Application.CutCopyMode = False Selection.Copy Sheets("Results").Select Range("D3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Emp Data").Select ActiveCell.Offset(0, 1).Select Application.CutCopyMode = False Selection.Copy Sheets("Results").Select Range("D4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Emp Data").Select ActiveCell.Offset(0, 2).Select Application.CutCopyMode = False Selection.Copy Sheets("Results").Select Range("D5").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Emp Data").Select ActiveCell.Offset(0, 1).Select Application.CutCopyMode = False Selection.Copy Sheets("Results").Select Range("D6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Emp Data").Select ActiveCell.Offset(0, 1).Select Application.CutCopyMode = False Selection.Copy Sheets("Results").Select Range("D13").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Emp Data").Select ActiveCell.Offset(0, 1).Select Application.CutCopyMode = False Selection.Copy Sheets("Results").Select Range("D15").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Emp Data").Select ActiveCell.Offset(0, 1).Select Application.CutCopyMode = False Selection.Copy Sheets("Results").Select Range("D8").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Emp Data").Select ActiveCell.Offset(0, 1).Select Application.CutCopyMode = False Selection.Copy Sheets("Results").Select Range("D10").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Emp Data").Select ActiveCell.Offset(0, 1).Select Application.CutCopyMode = False Selection.Copy Sheets("Results").Select Range("D11").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("J10").Select Application.CutCopyMode = False Selection.Copy Sheets("Emp Data").Select ActiveCell.Offset(0, 9).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Results").Select Range("J12").Select Application.CutCopyMode = False Selection.Copy Sheets("Emp Data").Select ActiveCell.Offset(0, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Results").Select Range("J11").Select Application.CutCopyMode = False Selection.Copy Sheets("Emp Data").Select ActiveCell.Offset(0, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Results").Select Range("d8").Select Application.CutCopyMode = False Selection.Copy Sheets("Emp Data").Select ActiveCell.Offset(0, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Results").Select Range("d3").Select Application.CutCopyMode = False Selection.Copy Sheets("Emp Data").Select ActiveCell.Offset(0, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Results").Select Range("j26").Select Application.CutCopyMode = False Selection.Copy Sheets("Emp Data").Select ActiveCell.Offset(0, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Results").Select Range("j27").Select Application.CutCopyMode = False Selection.Copy Sheets("Emp Data").Select ActiveCell.Offset(0, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Emp Data").Select ActiveCell.Offset(1, -29).Select FILEDONE = ActiveCell.Value Loop End Sub

I have tried implementing the .value method from other tutorials, but I have not been able to figure out how to properly implement it. Any help with improving this code and understanding this topic more would be greatly appreciated.

Improve this question
2
  • 2
    Another recommendation would be to avoid using Select. Commented Apr 12, 2024 at 15:53
  • 2
    Assigning value is more efficient than select/copy/paste. eg. Sheets("Results").Range("D1").Value = Sheets("Emp Data").Range("E5").Value. Commented Apr 12, 2024 at 16:01

1 Answer 1

Reset to default
0

Improve Macro-Recorder Code

  • Not tested!
Sub UpdateEmpData() ' Define constants. Const EMP_FIRST_ROW As Long = 12 Const EMP_BLANK_INDEX As Long = 0 Dim eColsRead() As Variant: eColsRead = VBA.Array( _ "A", "B", "F", "G", "I", _ "J", "K", "L", "M", "N", _ "O") Dim rCellsWrite() As Variant: rCellsWrite = VBA.Array( _ "D2", "D14", "D3", "D4", "D5", _ "D6", "D13", "D15", "D8", "D10", _ "D11") Dim rCellsRead() As Variant: rCellsRead = VBA.Array( _ "J10", "J12", "J11", "D8", "D3", _ "J26", "J27") Dim eColsWrite() As Variant: eColsWrite = VBA.Array( _ "X", "Y", "Z", "AA", "AB", _ "AC", "AD") ' Reference the objects (workbook and worksheets). Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code Dim ews As Worksheet: Set ews = wb.Sheets("Emp Data") Dim rws As Worksheet: Set rws = wb.Sheets("Results") ' Write... rws.Range("D1").Value = ews.Range("E5").Value ' Set the first row in Emp. Dim er As Long: er = EMP_FIRST_ROW ' Loop... Dim c As Long Do If Len(CStr(ews.Cells(er, eColsRead(EMP_BLANK_INDEX)).Value)) = 0 Then Exit Do ' when cell in column 'A' is blank End If ' Read from Emp, write to Results. For c = 0 To UBound(eColsRead) rws.Range(rCellsWrite(c)).Value = ews.Cells(er, eColsRead(c)).Value Next c ' Read from Results, write to Emp. For c = 0 To UBound(eColsWrite) ews.Cells(er, eColsWrite(c)).Value = rws.Range(rCellsRead(c)).Value Next c er = er + 1 Loop ' Inform. MsgBox "Emp data updated.", vbInformation End Sub
Improve this answer
Sign up to request clarification or add additional context in comments.

Comments

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.