Again I must say, Pascal you have been extremely kind in spending your time with this, it is very much appreciated I am now going through the code trying to understand, Thanks and very best wishes Stewart
On Mar 4, 9:08 pm, bpascal123 <bpascal...@gmail.com> wrote: > Please find the code below with comment, although it is a little erratic... > It's really a basic pattern matching. > I assume G3198/3 is not the same as G31983 or 000G3198/3 or else... > > Sub CompareCopyPasteByeBye() > > '''DECLARE VARIABLES FOR OBJECTS AND ELSE > 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 'Dynamic array for components > Dim PartR() As String 'Dynamic array for PartR > > With Application 'Disable temporarly some excel features for faster > processing > .Calculation = xlCalculationManual > .ScreenUpdating = False > .DisplayAlerts = False > End With > > Set wbk = ThisWorkbook 'assign current workbook to make sure the code runs > on the right workbook > Set wksA = wbk.Worksheets(1) 'assign worksheet we're going to work with > 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 'technical stuff to make sure the > code below find the end cells > wksA.Range(wksA.Cells(1, 1), wksA.Cells(Rows.Count, > Columns.Count)).EntireColumn.Hidden = False > lastr = wksA.Cells(Rows.Count, 2).End(xlUp).Row 'find the last row > lastc = wksA.Cells(1, Columns.Count).End(xlToLeft).Column 'find the last > column > > Set Romeo = wksA.Range(wksA.Cells(1, 1), wksA.Cells(lastr, lastc)) 'assign > the range we need > > 'Assign values to array > 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 > '''''''''''''''''''''''''''''' > 'Same as with Sheet1 > 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 > '''''''''''''''''''''''''''''' > 'Copy header row from Part Ref sheet to sheet3 > wksB.Rows(1).Copy wksC.Rows(1) > > 'Check data that match and copy to sheet3 > 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 'highlight data > "pairs" on sheet1 and sheet2 > Romeo.Cells(j + 2, 2).Interior.ColorIndex = 3 > End If > Next j > Next i > > 'Remove cell highlights from sheet3 > wksC.Columns(6).Interior.ColorIndex = xlNone > > With Application 'return excel to its previous settings > .Calculation = xlCalculationAutomatic > .ScreenUpdating = True > .DisplayAlerts = True > End With > > End Sub > > On Sunday, March 4, 2012 2:47:20 PM UTC, trawets wrote: > > > > > 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 -- 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
