Better Way to Loop and Copy and Paste Items

[bayles]

Hi,

I currently have the following code running no problem (just a little slow for my liking). FYI crng is in ws2.

For Each Cell In crng
If Cell.Value = concatenate Then
r = Cell.row
Exit For
End If
Next Cell



If WS2.Cells(r, 8) <> "" Then
WS1.Cells(i, BranCol + x).Value = WS2.Cells(r, 8).Value ' copy new brand
End If
If WS2.Cells(r, 9) <> "" Then
WS1.Cells(i, BranCol + 5 + x).Value = WS2.Cells(r, 9).Value ' copy new manufacturer
End If




But I am looping through thousands of rows and multiple columns and just one column is taking 2 minutes to run.

My questions:
1. Is there a quicker way to search crng?
2. Is there a quicker way to copy the values from ws2 to ws1?

Thanks

 

[My Aswer Is This]

I do not believe you have provided all your code.

Like what is?

crng

And what is?

BranCo​

And I maybe could help if you were to tell me in words what you objective is.
I do not understand your code.​

 

[footoo]

Duplicate post : https://www.mrexcel.com/forum/excel...-through-3000-rows-5-columns-change-data.html

 

[bayles]

Hi,

Sorry I was trying to be succinct.

Here is all of it.

Sub IMPORT_ERROR_CHANGES()

Dim StartTime As Double
Dim SecondsElapsed As Double
Dim Cell, crng As Range
Dim BranCol, firstrow, lastrow As Integer
Dim WS As Worksheet
Set ws1 = Sheets("BvTrax")
Set WS2 = Sheets("DUPLICATED BRANDS")
' FIND FIRST AND LAST ROW OF DATA
firstrow = ws1.Cells.Find(What:="Description", After:=ws1.Range("A1"), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Offset(1, 0).row ' FIND ROW NUMBER OF DATA

BranCol = ws1.Cells.Find(What:="BRAND1", After:=ws1.Cells(firstrow, 1), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column ' THE COLUMN OF BRAND 1

regionID = ws1.Cells.Find(What:="regionID", After:=ws1.Cells(firstrow, 1), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column ' THE REGION ID


first = firstrow
Do Until ws1.Cells(first, 1) = ""

first = first + 1

Loop
lastrow = first ' FIND THE LAST ROW WITH DATA


Set crng = WS2.Range("G:G") ' RANGE IN DUPLICATED BRANDS WITH MATCHING CONCATENATE FORMULA

' CYCLE THROUGH AND CHECK EACH CELLS AND MAKE CORRECTIONS
i = firstrow
x = 0
Do Until x = 6


'Remember time when macro starts
StartTime = Timer

Do Until i = lastrow
If ws1.Cells(i, BranCol) <> "" Then
concatenate = ws1.Cells(i, regionID) & ws1.Cells(i, BranCol + x) & ws1.Cells(i, BranCol + 5 + x) & ws1.Cells(i, BranCol + 10 + x) & ws1.Cells(i, BranCol + 15 + x)

If Len(concatenate) < 254 Then
If Not WS2.Range("G:G").Find(What:=concatenate, After:=WS2.Range("G1"), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext) Is Nothing Then

r = WS2.Range("G:G").Find(What:=concatenate, After:=WS2.Range("G1"), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext).row
Else
GoTo Nextiteration
End If
Else
For Each Cell In crng
If Cell.Value = concatenate Then
r = Cell.row
Exit For
End If
Next Cell
End If

If WS2.Cells(r, 8) <> "" Then
ws1.Cells(i, BranCol + x).Value = WS2.Cells(r, 8).Value ' copy new brand
End If
If WS2.Cells(r, 9) <> "" Then
ws1.Cells(i, BranCol + 5 + x).Value = WS2.Cells(r, 9).Value ' copy new manufacturer
End If
End If
Nextiteration:
i = i + 1
Loop
i = firstrow
'Determine how many seconds code took to run
SecondsElapsed = Round(Timer - StartTime, 2)

'Notify user in seconds
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
x = x + 1
Loop


End Sub

 

[bayles]

Duplicate post : https://www.mrexcel.com/forum/excel...-through-3000-rows-5-columns-change-data.html

Hi footoo,

Yes I realise it is but I wanted to be more succinct in my question / objective and thought this second post did that better.

Thanks

 

[bayles]

I do not believe you have provided all your code.

Like what is?

crng

And what is?

BranCo​

And I maybe could help if you were to tell me in words what you objective is.
I do not understand your code.​

My objective is to compare 5 different cell values on the same row in one sheet (ws1), then look for that same combination on the other sheet (ws2).

In the row with the matching concatenate I may or may not have entered a value to overwrite one of the 5 variables. It is looping through 3000 rows / 5 columns (15,000 loops) and is searching 9000 rows in ws2.

The whole process takes about 9 minutes to fully run and I am sure there is a way to speed up the code.

Thanks

 

[footoo]

Hi footoo,

Yes I realise it is but I wanted to be more succinct in my question / objective and thought this second post did that better.

Thanks

Of course you realize it, but how do others know?
If you start a new thread that is a follow-on from another thread, provide a link to the other thread.
And a link on the old thread to the new thread - so that people do not spend time answering something that has already been resolved.

 

[Fluff]

@bayles
Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread.
Per forum rules, posts of a duplicate nature will be locked or deleted (rule 12 here: Forum Rules).