Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to speed up code
I am trying to find item codes that have different suffixes on the for
example color. Data A B C D E F ITEMS TO FIND ITEMS ITEMS FOUND VARIATIONS ACT 1111 ACT 1234 ACT 1237 ACT 1237-BK ACT 1235 ACT 1235 ACT 1237 ACT 1237-BR ACT 1235-GR ACT 1236 ACT 1237 ACT 1237-GR ACT 1237 ACT 1237 ACT 1237 ACT 1237-WT ACT 1239 ACT 1237-BK ACT 1237-BR ACT 1237-GR ACT 1237-WT ACT 1238 ACT 1239 What I am trying to do is find the items in column A that exist in column C that have suffixes and put the item from A in column E and its corisponding item (with suffix) in column F. Here is my code: Sub Run_Report() Dim x As Long Dim Item As Variant Range("a2").Select x = 2 While Cells(x, 1) < "" Item = Cells(x, 1) Find_Variations Item x = x + 1 Wend End Sub Sub Find_Variations(Item As Variant) Dim y, z As Long y = 2 ' track where we are in column C z = 2 ' track where we are in columns E & F While Cells(y, 3) < "" 'Look for Item in column C If Item = Left(Cells(y, 3), Len(Item)) Then If Item < Cells(y, 3) Then ' we don't want to find exact matchs Cells(z, 5) = Item Cells(z, 6) = Cells(y, 3) z = z + 1 End If End If y = y + 1 Wend End Sub The problem is I have 3,000 items in column A and 40,000 items in column C. So the code takes a long time. I wanted to use VLOOKUP but it will not find all variations. Is there any other options? Any ideas on speeding up the code? By the way the example above Columns E and F are the actual result that I want. DG |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to speed up code
Dan,
One improvement would be to include Application.screenupdating=false your code Application.screenupdating = true Mike "Dan" wrote: I am trying to find item codes that have different suffixes on the for example color. Data A B C D E F ITEMS TO FIND ITEMS ITEMS FOUND VARIATIONS ACT 1111 ACT 1234 ACT 1237 ACT 1237-BK ACT 1235 ACT 1235 ACT 1237 ACT 1237-BR ACT 1235-GR ACT 1236 ACT 1237 ACT 1237-GR ACT 1237 ACT 1237 ACT 1237 ACT 1237-WT ACT 1239 ACT 1237-BK ACT 1237-BR ACT 1237-GR ACT 1237-WT ACT 1238 ACT 1239 What I am trying to do is find the items in column A that exist in column C that have suffixes and put the item from A in column E and its corisponding item (with suffix) in column F. Here is my code: Sub Run_Report() Dim x As Long Dim Item As Variant Range("a2").Select x = 2 While Cells(x, 1) < "" Item = Cells(x, 1) Find_Variations Item x = x + 1 Wend End Sub Sub Find_Variations(Item As Variant) Dim y, z As Long y = 2 ' track where we are in column C z = 2 ' track where we are in columns E & F While Cells(y, 3) < "" 'Look for Item in column C If Item = Left(Cells(y, 3), Len(Item)) Then If Item < Cells(y, 3) Then ' we don't want to find exact matchs Cells(z, 5) = Item Cells(z, 6) = Cells(y, 3) z = z + 1 End If End If y = y + 1 Wend End Sub The problem is I have 3,000 items in column A and 40,000 items in column C. So the code takes a long time. I wanted to use VLOOKUP but it will not find all variations. Is there any other options? Any ideas on speeding up the code? By the way the example above Columns E and F are the actual result that I want. DG |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to speed up code
Thanks Mike, acctually I have that but did not show it.
What I was thinking was a way to find the row number of the first occurance of Item. Then I can start there instead of at the beginning. If I can't do that I would write code that would check is Items is greater than cell(a,b) then jump to cells(rowcount/2,b) and compare, if Item is less split it in half on the bottom(1/4 row). If greater go to the 3/4 row. etc. Then I may only loop 200 times instead of 20,000. I don't know if I'm clear here. I've done it before but it was long ago. DG "Mike H" wrote in message ... Dan, One improvement would be to include Application.screenupdating=false your code Application.screenupdating = true Mike "Dan" wrote: I am trying to find item codes that have different suffixes on the for example color. Data A B C D E F ITEMS TO FIND ITEMS ITEMS FOUND VARIATIONS ACT 1111 ACT 1234 ACT 1237 ACT 1237-BK ACT 1235 ACT 1235 ACT 1237 ACT 1237-BR ACT 1235-GR ACT 1236 ACT 1237 ACT 1237-GR ACT 1237 ACT 1237 ACT 1237 ACT 1237-WT ACT 1239 ACT 1237-BK ACT 1237-BR ACT 1237-GR ACT 1237-WT ACT 1238 ACT 1239 What I am trying to do is find the items in column A that exist in column C that have suffixes and put the item from A in column E and its corisponding item (with suffix) in column F. Here is my code: Sub Run_Report() Dim x As Long Dim Item As Variant Range("a2").Select x = 2 While Cells(x, 1) < "" Item = Cells(x, 1) Find_Variations Item x = x + 1 Wend End Sub Sub Find_Variations(Item As Variant) Dim y, z As Long y = 2 ' track where we are in column C z = 2 ' track where we are in columns E & F While Cells(y, 3) < "" 'Look for Item in column C If Item = Left(Cells(y, 3), Len(Item)) Then If Item < Cells(y, 3) Then ' we don't want to find exact matchs Cells(z, 5) = Item Cells(z, 6) = Cells(y, 3) z = z + 1 End If End If y = y + 1 Wend End Sub The problem is I have 3,000 items in column A and 40,000 items in column C. So the code takes a long time. I wanted to use VLOOKUP but it will not find all variations. Is there any other options? Any ideas on speeding up the code? By the way the example above Columns E and F are the actual result that I want. DG |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to speed up code
Perhaps even: Application.Calculation = xlManual 'your code Application.Calculation = xlAutomatic to prevent recalculation everytime. -- Simon Lloyd Regards, Simon Lloyd 'www.thecodecage.com' (http://www.thecodecage.com) ------------------------------------------------------------------------ Simon Lloyd's Profile: http://www.thecodecage.com/forumz/member.php?userid=1 View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=23639 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to speed up code
On Oct 31, 10:32 am, "Dan" wrote:
I am trying to find item codes that have different suffixes on the for example color. Data A B C D E F ITEMS TO FIND ITEMS ITEMS FOUND VARIATIONS ACT 1111 ACT 1234 ACT 1237 ACT 1237-BK ACT 1235 ACT 1235 ACT 1237 ACT 1237-BR ACT 1235-GR ACT 1236 ACT 1237 ACT 1237-GR ACT 1237 ACT 1237 ACT 1237 ACT 1237-WT ACT 1239 ACT 1237-BK ACT 1237-BR ACT 1237-GR ACT 1237-WT ACT 1238 ACT 1239 What I am trying to do is find the items in column A that exist in column C that have suffixes and put the item from A in column E and its corisponding item (with suffix) in column F. Here is my code: Sub Run_Report() Dim x As Long Dim Item As Variant Range("a2").Select x = 2 While Cells(x, 1) < "" Item = Cells(x, 1) Find_Variations Item x = x + 1 Wend End Sub Sub Find_Variations(Item As Variant) Dim y, z As Long y = 2 ' track where we are in column C z = 2 ' track where we are in columns E & F While Cells(y, 3) < "" 'Look for Item in column C If Item = Left(Cells(y, 3), Len(Item)) Then If Item < Cells(y, 3) Then ' we don't want to find exact matchs Cells(z, 5) = Item Cells(z, 6) = Cells(y, 3) z = z + 1 End If End If y = y + 1 Wend End Sub The problem is I have 3,000 items in column A and 40,000 items in column C. So the code takes a long time. I wanted to use VLOOKUP but it will not find all variations. Is there any other options? Any ideas on speeding up the code? By the way the example above Columns E and F are the actual result that I want. DG Use constants when you have a lot of loops Avoid variants when you know what object is eg Excel.range The .Find, .FindNext can really speed things up Try something like this: Sub Run_Report() Dim rLookUp As Excel.Range 'Column of items to find Dim rFindIn As Excel.Range 'Column of items Dim rFind As Excel.Range 'Any given cell in rLookUp Dim rOutput As Excel.Range 'Two columns of output 'These assume that there is column between following ranges and no spaces 'You may need to specify these differently Set rLookUp = Range("A2").CurrentRegion Set rLookUp = rLookUp.Offset(1, 0).Resize(rLookUp.Rows.Count - 1) Set rFindIn = Range("c2").CurrentRegion Set rFindIn = rFindIn.Offset(1, 0).Resize(rFindIn.Rows.Count - 1) Set rOutput = Range("E2:F2") For Each rFind In rLookUp.Cells If rFind.Value < vbNullString Then Find_Variations rFind.Value, rFindIn, rOutput End If Next End Sub Sub Find_Variations(ByRef FindThis As String, ByRef FindIn As Excel.Range, ByRef OutputRange As Excel.Range) Dim rCell As Excel.Range 'Any given cell that contains FindThis Dim sFirstAddress As String 'Address of first cell found. Need to check this so don't go into continuous loop 'See if FindThis is in items Set rCell = FindIn.Find(what:=FindThis, after:=FindIn.Cells(FindIn.Rows.Count, 1), LookIn:=xlValues, Lookat:=xlPart) 'If not, exit sub If Not rCell Is Nothing Then 'if found, save address sFirstAddress = rCell.Address Do 'Your Checks 'Is left of item = FindThis If InStr(1, rCell.Value, FindThis) = 1 Then 'If same length, then FindThis = item, so skip If Len(FindThis) < Len(rCell.Value) Then 'Output data OutputRange(OutputRange.Rows.Count, 1) = FindThis OutputRange(OutputRange.Rows.Count, 2) = rCell.Value 'Resize output range for next output Set OutputRange = OutputRange.Resize(OutputRange.Rows.Count + 1) End If End If 'See if another cell meets criteria Set rCell = FindIn.FindNext(rCell) 'Loop until nothing found or address is first address found Loop While Not rCell Is Nothing And rCell.Address < sFirstAddress End If End Sub |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to speed up code
Thanks, Exactly what I was looking for.
DG "dbKemp" wrote in message ... On Oct 31, 10:32 am, "Dan" wrote: I am trying to find item codes that have different suffixes on the for example color. Data A B C D E F ITEMS TO FIND ITEMS ITEMS FOUND VARIATIONS ACT 1111 ACT 1234 ACT 1237 ACT 1237-BK ACT 1235 ACT 1235 ACT 1237 ACT 1237-BR ACT 1235-GR ACT 1236 ACT 1237 ACT 1237-GR ACT 1237 ACT 1237 ACT 1237 ACT 1237-WT ACT 1239 ACT 1237-BK ACT 1237-BR ACT 1237-GR ACT 1237-WT ACT 1238 ACT 1239 What I am trying to do is find the items in column A that exist in column C that have suffixes and put the item from A in column E and its corisponding item (with suffix) in column F. Here is my code: Sub Run_Report() Dim x As Long Dim Item As Variant Range("a2").Select x = 2 While Cells(x, 1) < "" Item = Cells(x, 1) Find_Variations Item x = x + 1 Wend End Sub Sub Find_Variations(Item As Variant) Dim y, z As Long y = 2 ' track where we are in column C z = 2 ' track where we are in columns E & F While Cells(y, 3) < "" 'Look for Item in column C If Item = Left(Cells(y, 3), Len(Item)) Then If Item < Cells(y, 3) Then ' we don't want to find exact matchs Cells(z, 5) = Item Cells(z, 6) = Cells(y, 3) z = z + 1 End If End If y = y + 1 Wend End Sub The problem is I have 3,000 items in column A and 40,000 items in column C. So the code takes a long time. I wanted to use VLOOKUP but it will not find all variations. Is there any other options? Any ideas on speeding up the code? By the way the example above Columns E and F are the actual result that I want. DG Use constants when you have a lot of loops Avoid variants when you know what object is eg Excel.range The .Find, .FindNext can really speed things up Try something like this: Sub Run_Report() Dim rLookUp As Excel.Range 'Column of items to find Dim rFindIn As Excel.Range 'Column of items Dim rFind As Excel.Range 'Any given cell in rLookUp Dim rOutput As Excel.Range 'Two columns of output 'These assume that there is column between following ranges and no spaces 'You may need to specify these differently Set rLookUp = Range("A2").CurrentRegion Set rLookUp = rLookUp.Offset(1, 0).Resize(rLookUp.Rows.Count - 1) Set rFindIn = Range("c2").CurrentRegion Set rFindIn = rFindIn.Offset(1, 0).Resize(rFindIn.Rows.Count - 1) Set rOutput = Range("E2:F2") For Each rFind In rLookUp.Cells If rFind.Value < vbNullString Then Find_Variations rFind.Value, rFindIn, rOutput End If Next End Sub Sub Find_Variations(ByRef FindThis As String, ByRef FindIn As Excel.Range, ByRef OutputRange As Excel.Range) Dim rCell As Excel.Range 'Any given cell that contains FindThis Dim sFirstAddress As String 'Address of first cell found. Need to check this so don't go into continuous loop 'See if FindThis is in items Set rCell = FindIn.Find(what:=FindThis, after:=FindIn.Cells(FindIn.Rows.Count, 1), LookIn:=xlValues, Lookat:=xlPart) 'If not, exit sub If Not rCell Is Nothing Then 'if found, save address sFirstAddress = rCell.Address Do 'Your Checks 'Is left of item = FindThis If InStr(1, rCell.Value, FindThis) = 1 Then 'If same length, then FindThis = item, so skip If Len(FindThis) < Len(rCell.Value) Then 'Output data OutputRange(OutputRange.Rows.Count, 1) = FindThis OutputRange(OutputRange.Rows.Count, 2) = rCell.Value 'Resize output range for next output Set OutputRange = OutputRange.Resize(OutputRange.Rows.Count + 1) End If End If 'See if another cell meets criteria Set rCell = FindIn.FindNext(rCell) 'Loop until nothing found or address is first address found Loop While Not rCell Is Nothing And rCell.Address < sFirstAddress End If End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Need to Speed Up A Code | Excel Worksheet Functions | |||
Ned to speed up my code | Excel Programming | |||
Speed up Code? | Excel Programming | |||
Speed up code | Excel Programming | |||
Code Speed Up | Excel Programming |