G'day,
I have data in a master sheet (BvTrax) which I am trying to compare to another sheet (DUPLICATED BRANDS) where I have made some suggested corrections.
I have created a string of multiple cell values in the master sheet (BvTrax) to compare to the corrections sheet (DUPLICATED BRANDS). If 2 cells in that row contain corrections then overwrite the changes in master.
The number of rows does vary and at the moment I have about 3000 rows but it is grinding to a halt. It all appears to work ok at the moment, I just need to speed it up.
I am positive there is a quicker method but my limited skills cannot do it.
Thanks
Ryan
Dim Cell, crng As Range
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
Do Until i = lastrow
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 concatenate <> "" Then
For Each Cell In crng
If Cell.Value = concatenate Then
If Cell.Offset(0, 1) <> "" Then
WS1.Cells(i, BranCol + x) = Cell.Offset(0, 1) ' copy new brand
End If
If Cell.Offset(0, 2) <> "" Then
WS1.Cells(i, BranCol + 5 + x).Value = Cell.Offset(0, 2).Value ' copy new manufacturer
End If
Exit For
End If
Next Cell
End If
i = i + 1
Loop
x = 1
Loop
I have data in a master sheet (BvTrax) which I am trying to compare to another sheet (DUPLICATED BRANDS) where I have made some suggested corrections.
I have created a string of multiple cell values in the master sheet (BvTrax) to compare to the corrections sheet (DUPLICATED BRANDS). If 2 cells in that row contain corrections then overwrite the changes in master.
The number of rows does vary and at the moment I have about 3000 rows but it is grinding to a halt. It all appears to work ok at the moment, I just need to speed it up.
I am positive there is a quicker method but my limited skills cannot do it.
Thanks
Ryan
Dim Cell, crng As Range
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
Do Until i = lastrow
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 concatenate <> "" Then
For Each Cell In crng
If Cell.Value = concatenate Then
If Cell.Offset(0, 1) <> "" Then
WS1.Cells(i, BranCol + x) = Cell.Offset(0, 1) ' copy new brand
End If
If Cell.Offset(0, 2) <> "" Then
WS1.Cells(i, BranCol + 5 + x).Value = Cell.Offset(0, 2).Value ' copy new manufacturer
End If
Exit For
End If
Next Cell
End If
i = i + 1
Loop
x = 1
Loop
