Please help optimize this code if possible to run quicker. Currently program works as intended but I think their may be a better way to copy/paste data into next empty column besides this lengthy else if statement.
Sub compare()
Dim N
Dim mystr
Dim MyComp
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LastRow
N = Range("A" & i)
mystr = Replace(N, Right(N, 8), "")
If Worksheets("Sheet1").Range("A2:A66000").Find(mystr) Is Nothing Then
Else
Set mystr = Worksheets("Sheet1").Range("A2:A66000").Find(mystr, LookAt:=xlWhole)
cn = mystr.Address
'' Portion of code I wish to optimize
If IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 1)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 1)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 2)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 2)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 3)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 3)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 4)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 4)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 5)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 5)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 6)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 6)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 7)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 7)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 8)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 8)
ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 9)) = True Then
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 9)
Else
Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 10)
End If
End If
Next i
End Sub
Use the Range.End
method.
With Worksheets("Sheet1")
.Cells(cn.Row,.Columns.Count).End(xlToLeft).Offset(,1).Value = _
Worksheets("Sheet2").Range("A" & i).Value
End WIth
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.