Thanks for the code and having tried this it works well, would it be possible to comment the code so I could follow it step by step and maybe try understand whats happens and when
On Mar 4, 2:55 am, bpascal123 <bpascal...@gmail.com> wrote: > Hi Trawets, > > Find your workbook attached, it should do. > Please check the accuracy, since your data there are symbols and other > stuff in your data, it could match data that don't include dashes or > slashes... and the code below should be tweaked. > I think you can run it from the vba editor window or ask if it's new > to you. Hope it helps. > > Option Explicit > > Sub CompareCopyPasteByeBye() > > Dim wbk As Workbook > Dim wksA As Worksheet > Dim wksB As Worksheet > Dim wksC As Worksheet > Dim i As Long, j As Long, r As Long > Dim n As Long, m As Long > Dim lastr As Long, lastc As Long > Dim Romeo As Range, Sierra As Range > Dim Comp() As String > Dim PartR() As String > > With Application > .Calculation = xlCalculationManual > .ScreenUpdating = False > .DisplayAlerts = False > End With > > Set wbk = ThisWorkbook > Set wksA = wbk.Worksheets(1) > Set wksB = wbk.Worksheets(2) > Set wksC = wbk.Worksheets(3) > > '''''''''''''''''''''''''''''''''''''''''' > 'SHEET1 Components - Affectation to array > '''''''''''''''''''''''''''''''''''''''''' > > wksA.Range(wksA.Cells(1, 1), wksA.Cells(Rows.Count, > Columns.Count)).EntireRow.Hidden = False > lastr = wksA.Cells(Rows.Count, 2).End(xlUp).Row > lastc = wksA.Cells(1, Columns.Count).End(xlToLeft).Column > > Set Romeo = wksA.Range(wksA.Cells(1, 1), wksA.Cells(lastr, lastc)) > > ReDim Comp(lastr - 2) > For i = 2 To lastr > Comp(i - 2) = CStr(Romeo.Cells(i, 2)) > Next i > > '''''''''''''''''''''''''''''' > 'SHEET2 - Part Ref Affectation to array > '''''''''''''''''''''''''''''' > > wksB.Range(wksB.Cells(1, 1), wksB.Cells(Rows.Count, > Columns.Count)).EntireRow.Hidden = False > lastr = wksB.Cells(Rows.Count, 6).End(xlUp).Row > lastc = wksB.Cells(1, Columns.Count).End(xlToLeft).Column > > Set Sierra = wksB.Range(wksB.Cells(1, 1), wksB.Cells(lastr, lastc)) > > ReDim PartR(lastr - 2) > For i = 2 To lastr > PartR(i - 2) = CStr(Sierra.Cells(i, 6)) > Next i > > '''''''''''''''''''''''''''''' > 'EXPORTING Header > 'STRING COMPARAISON > 'Pasting Part ref values that match components > '''''''''''''''''''''''''''''' > > wksB.Rows(1).Copy wksC.Rows(1) > > r = 2 > > For i = 0 To UBound(PartR) > For j = 0 To UBound(Comp) > If PartR(i) = Comp(j) Then > Sierra.Rows(i + 2).Copy wksC.Rows(r) > r = r + 1 > Sierra.Cells(i + 2, 6).Interior.ColorIndex = 3 > Romeo.Cells(j + 2, 2).Interior.ColorIndex = 3 > End If > Next j > Next i > > wksC.Columns(6).Interior.ColorIndex = xlNone > > With Application > .Calculation = xlCalculationAutomatic > .ScreenUpdating = True > .DisplayAlerts = True > End With > > End Sub > > -o- > > There should be (is) a better code than this, please let me know for > any optimization, 6000 rows, about 10 columns, for one array, half > less I think for another array, my 2 dynamic arrays hold key values > and the code takes 1 to 3 seconds to run single core pentium 4... I > would like to know if this can be done full speed using > scripting.dictionary or other methods (i'm not looking for an > algorithm killer here):) > > Is anyone looking at this code able to assess my level of vba (it took > me 2 hours to produce this) since I don't how far i can use this skill > to apply for a job with vba skill require (i'm first an accountant and > for now i feel more comfortable with accounting but I do spend a lot > of time coding...i'm able to connect excel to database and words and > run queries or else however still with some time)? > > Pascal Baro -- FORUM RULES (986+ members already BANNED for violation) 1) Use concise, accurate thread titles. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get quick attention or may not be answered. 2) Don't post a question in the thread of another member. 3) Don't post questions regarding breaking or bypassing any security measure. 4) Acknowledge the responses you receive, good or bad. 5) Cross-promotion of, or links to, forums competitive to this forum in signatures are prohibited. NOTE : Don't ever post personal or confidential data in a workbook. Forum owners and members are not responsible for any loss. ------------------------------------------------------------------------------------------------------ To post to this group, send email to excel-macros@googlegroups.com
