PDA

View Full Version : Solved: Matching 2 customer record sheets



zaboo9
06-28-2010, 01:55 PM
I have created 5 excel sheets to help in my explanation, they are:
OldInfo: This is data currently in my database
NewInfo: Data received from a purchase of a company that I need to merge
MatchedResults: A new sheet created from OldInfo and NewInfo that shows how I want matches to appear.
UnmatchedResultsOldInfo: This is the OldInfo data with the matched rows taken out
UnmatchedResultsFromNewInfo: This is the NewInfo data with the matched rows taken out

My company purchased another company, and I need to merge records of businesses that both companies have in their databases. The only guaranteed unique identifier is the “MJ Business Number,” this is given to companies in my industry and a company can only have one of these numbers. I ONLY want to match based on the MJ Business Number at this point.

I want the NewInfo to be compared against the OldInfo information, and when a match is found, I want the matched information from both data sheets placed into the “MatchedResults” sheet as shown in the MatchedResults file. I want the matched items taken out of the NewInfo and OldInfo files, and when the ALL matched files are taken out, I want the NewInfo saved as UnmatchedResultsFromNewInfo and OldInfo saved as UnmatchedResultsOldInfo.

In short, I want the information to appear as it does in the example files. Please let me know if there are any questions.
Thanks so much in advance for any help you can provide.

Bob Phillips
06-28-2010, 02:35 PM
And what have you tried to date?

zaboo9
06-28-2010, 04:49 PM
I am new at VBA, I am mediocore in JAVA, so I have been studying VBA and trying to learn it mostly. I have been able to do some sorting with vlookup, however I need to more fully automate this process because I am an intern and won't be at this company after this summer, and someone will need to continue this process. VBA appears to be the best way.
In short, I have spent weeks studying VBA and searching to find an answer, but I haven't yet attained the knowledge to complete the task, nor found code online to use or modify to solve the problem.

GTO
06-28-2010, 04:49 PM
Just a sleepless stab...

Presuming a one-time deal, Old, New, and four add'l sheets in same wb. Alter header rows to match source data and format after done. I did not even attempt to split matching records to one sheet, I figure copy/paste must be good for something...


Option Explicit

Sub exa()
Dim _
OldInfo As Object, _
NewInfo As Object, _
a As Variant, _
i As Long

Set OldInfo = DIC(shtOld.Range(shtOld.Range("A2"), shtOld.Cells(Rows.Count, "A").End(xlUp)))
Set NewInfo = DIC(shtNew.Range(shtNew.Range("A2"), shtNew.Cells(Rows.Count, "A").End(xlUp)))

For Each a In OldInfo
i = i + 1
If NewInfo.Exists(a) Then
shtOld.Rows(i + 1).EntireRow.Copy shtMatchOld.Cells(Rows.Count, 1).End(xlUp).Offset(1)
Else
shtOld.Rows(i + 1).EntireRow.Copy shtNoMatchOld.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next

i = 0
For Each a In NewInfo
i = i + 1
If OldInfo.Exists(a) Then
shtNew.Rows(i + 1).EntireRow.Copy ShtMatchNew.Cells(Rows.Count, 1).End(xlUp).Offset(1)
Else
shtNew.Rows(i + 1).EntireRow.Copy shtNoMatchNew.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next
End Sub

Function DIC(rng As Range) As Object
Dim rCell As Range
Dim i As Long

Set DIC = CreateObject("Scripting.Dictionary")

For Each rCell In rng
i = i + 1
DIC.Item(rCell.Value) = rCell.Value
Next
End Function

Maybe?

Mark

PS - Please note, codenames used for ease...

zaboo9
06-29-2010, 01:58 PM
GTO,
Thank you very much for the help. I now have two new problems I've encountered:
1. Sometimes the MJ Business Number will be blank (I didn't have any in the example that were blank...), and when that happens, the array/object that holds the list, it doesn't seem to be storing all of the blanks.

2. I added code to the method that checks for a blank, and when there is a blank it is supposed to copy the row and places it in the NoMatch_Old or NoMatch_New respectively; however, this isn't working because it is skipping some of the blanks due to it not being stored properly in the array/object.

I have posted the modified data set. Any ideas? I have spent 5-6 hours today on this, but couldn't figure out how to handle the blank spaces with If, else, elseif statements.
Thanks so much for all the help!

GTO
06-30-2010, 08:07 AM
GTO,
Thank you very much for the help. I now have two new problems I've encountered:
1. Sometimes the MJ Business Number will be blank (I didn't have any in the example that were blank...), and when that happens, the array/object that holds the list, it doesn't seem to be storing all of the blanks.

2. I added code to the method that checks for a blank, and when there is a blank it is supposed to copy the row and places it in the NoMatch_Old or NoMatch_New respectively; however, this isn't working because it is skipping some of the blanks due to it not being stored properly in the array/object.

Hi again,

#1 would have been a good thing to have mentioned. The Dictionary will only store unique keys, which I was assuming that no MJ number will be listed twice, and that there would be no blanks. See, it would only store one blank, so we'd be toast there, but more importantly, I was just using the dictionary for the .Exists method.

As we may have blank vals in the MJ number column, at least for anything my poor brain could think of, dictionary no longer sounded very stellar.

If I have been paying good enough attention though, I think we can use the worksheet function MATCH in the code, in place of .Exists.

I ran out of time to verify results, but a quick check seemed promising.

In your wb from #5, try:


Option Explicit

Sub exa()
Dim _
rngOld As Range, _
rngNew As Range, _
a As Variant, _
i As Long

'// Set a base range to search for the last row of data, as we cannot depend upon //
'// there being a MJ Num in the last record. //
Set rngOld = shtOld.Range(shtOld.Range("A2"), shtOld.Cells(shtOld.Rows.Count, "H"))
'// Set our range based on finding the last true row from above. //
Set rngOld = shtOld.Range(shtOld.Range("A2"), _
shtOld.Cells(RangeFound(rngOld, , rngOld.Cells(1)).Row, "A"))
'//SAA
Set rngNew = shtNew.Range(shtNew.Range("A2"), shtNew.Cells(shtNew.Rows.Count, "D"))
Set rngNew = shtNew.Range(shtNew.Range("A2"), _
shtNew.Cells(RangeFound(rngNew, , rngNew.Cells(1)).Row, "A"))

'// IF I have this right (a bit chancy at best), I think I am using Application.MATCH//
'// to either find each val (or that is, the row in the array), which would return a//
'// TRUE for NOT ISERROR, or, return a FALSE if not found or an error due to an //
'// empty string being supplied. //
For i = 1 To UBound(rngOld.Value, 1)
If Not IsError(Application.Match(rngOld.Value(xlRangeValueDefault)(i, 1), rngNew, 0)) Then
rngOld.Cells(i).EntireRow.Copy _
shtMatchOld.Cells( _
RangeFound( _
shtMatchOld.Range(shtMatchOld.Range("A1"), _
shtMatchOld.Cells(shtMatchOld.Rows.Count, "H") _
), , _
shtMatchOld.Cells(1) _
).Row, 1).Offset(1)
Else
rngOld.Cells(i).EntireRow.Copy _
shtNoMatchOld.Cells( _
RangeFound(shtNoMatchOld.Range(shtNoMatchOld.Range("A1"), _
shtNoMatchOld.Cells(shtNoMatchOld.Rows.Count, "H") _
), , shtNoMatchOld.Cells(1) _
).Row, 1).Offset(1)
End If
Next

For i = 1 To UBound(rngOld.Value, 1)
If Not IsError(Application.Match(rngNew.Value(xlRangeValueDefault)(i, 1), rngOld, 0)) Then
rngNew.Cells(i).EntireRow.Copy _
ShtMatchNew.Cells( _
RangeFound(ShtMatchNew.Range(ShtMatchNew.Range("A1"), _
ShtMatchNew.Cells(ShtMatchNew.Rows.Count, "D") _
), , ShtMatchNew.Cells(1) _
).Row, 1).Offset(1)
Else
rngNew.Cells(i).EntireRow.Copy _
shtNoMatchNew.Cells( _
RangeFound(shtNoMatchNew.Range(shtNoMatchNew.Range("A1"), _
shtNoMatchNew.Cells(shtNoMatchNew.Rows.Count, "D") _
), , shtNoMatchNew.Cells(1) _
).Row, 1).Offset(1)
End If
Next
End Sub

Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

Mark

GTO
06-30-2010, 08:36 AM
Ack. I forgot to mention that the destination sheets will require having at least one value in the header row...

zaboo9
07-01-2010, 09:09 AM
The code worked on the sample data I sent you, but when I used it on the actual data, it started matching blank spaces. The actual data file is huge (65000 records on the Old sheet, and 1100 on the New), and there are more columns then I provided on the sample data.

I have attached another sheet (Thursday.xls) that has all of the columns but not all the rows (Since it is a huge file), and I just changed some data of the customers. The MJ number is actually 9 numbers long, so I included those as 9 digit numbers as well.

When the code is run on this Thursday.xls, it puts all but 1 blank into the NoMatch sheets (As you'll see when the code is run.) I looked through the code and tried to see if I could change it to make it so no blanks were matched by changing the
" Set rngOld = shtOld.Range(shtOld.Range("A2"), shtOld.Cells(shtOld.Rows.Count, "H"))" and
Set rngNew = shtNew.Range(shtNew.Range("A2"), shtNew.Cells(shtNew.Rows.Count, "D"))"
So that they go to the proper columns (Q and V) but I couldn't make it work.

Any suggestions? Thanks for the help again!

zaboo9
07-01-2010, 12:07 PM
I found the problem, there were leading apostrophes in the "blank cells." I set the MJ number cells as Text, copied the MJ number cells, pasted them in Notepad, then copied the info in notedpad and pasted it back into Excel and the apostrophes are now gone. I'm re-running the code again, it takes about 2 hours. I'll let you know the outcome

GTO
07-01-2010, 03:16 PM
I found the problem, there were leading apostrophes in the "blank cells." I set the MJ number cells as Text, copied the MJ number cells, pasted them in Notepad, then copied the info in notedpad and pasted it back into Excel and the apostrophes are now gone. I'm re-running the code again, it takes about 2 hours. I'll let you know the outcome

I am off to bed, so will have to look later. If I am reading your last two posts correctly at all, I think that running thru 65+k rows is not going to be blindingly quick no matter what. Again, tired so maybe not thinking so well, but I'd think that we may want to flip the ranges into arrays, if for nothing else, the existance test.

I'm not sure if Appllication.Match is the fastest way to check through an array that long either, but maybe?

I would also figure on coming up with some counters someways, as .Find that many times cannot be the best answer.

For the first step though, try this to dump the prefix character (right below where the ranges are finalized):


rngOld.Value = rngOld.Value
rngNew.Value = rngNew.Value


Not well checked, but I think should work.

Mark

zaboo9
07-06-2010, 02:27 PM
Thank you for all your help, GTO. Sorry for the long delay in posting, The test runs, but at the end it gives the error, "Subscript out of range." I now am testing the code, and have just taken a small portion of the sheet to test on since the whole file takes two hours.

I have found that when "Old" has the same or less number of rows than "New", the code runs fine. When I have more rows in "Old" than "New" I get the error "Run-time error '9': Subscript out of range." However, it looks like the code runs perfectly fine, and all the other sheets are filled with all of the proper information.

I have attached my test Excel sheet, in its current state it is receiving the "Run-time error '9': Subscript out of range" and it will give you the option to debug (which I tried, but don't really understand) If you delete one row from the "Old" tab, it will run perfect without errors.

If you have more rows on "New" then it will run without errors, but it won't look at the row numbers that "Old" doesn't have.

Any suggestions on what to do?

Note:
1. I have the MJ Number column in both "Old" and "New" as text, and I typed in the numbers so there is no apostrophe, I'll worry about the leading apostrophe later.
2. I am now using Excel 2007, I hope its an improvement!

GTO
07-06-2010, 03:29 PM
Off to bed for me, but please edit the attachment or repost in .xls format. There are plenty (including yours truly) who have limited or no access to xlsm format.

zaboo9
07-07-2010, 05:57 AM
Good morning! Here is the file in .xls, thanks again!

zaboo9
07-12-2010, 02:01 PM
'// Set a base range to search for the last row of data, as we cannot depend upon //
'// there being a MJ Num in the last record. //
Set rngOld = shtOld.Range(shtOld.Range("A2"), shtOld.Cells(shtOld.Rows.Count, "H"))
'// Set our range based on finding the last true row from above. //
Set rngOld = shtOld.Range(shtOld.Range("A2"), _
shtOld.Cells(RangeFound(rngOld, , rngOld.Cells(1)).Row, "A"))
'//SAA
Set rngNew = shtNew.Range(shtNew.Range("A2"), shtNew.Cells(shtNew.Rows.Count, "D"))
Set rngNew = shtNew.Range(shtNew.Range("A2"), _
shtNew.Cells(RangeFound(rngNew, , rngNew.Cells(1)).Row, "A"))

zaboo9
07-12-2010, 02:04 PM
I'm trying to make the code below make it so it just knew the range by user input into input boxes (as shown below.) Any ideas on how to do this? I've only got the input boxes in this code.


Sub exa()
Dim _
rngOld As Range, _
rngNew As Range, _
a As Variant, _
i As Long, _
oldRows As Integer, _
newRows As Integer
oldRows = InputBox("How many rows in Old?")
newRows = InputBox("How many rows in New?")


'// Set a base range to search for the last row of data, as we cannot depend upon //
'// there being a MJ Num in the last record. //
Set rngOld = shtOld.Range(shtOld.Range("A2"), shtOld.Cells(shtOld.Rows.Count, "H"))
'// Set our range based on finding the last true row from above. //
Set rngOld = shtOld.Range(shtOld.Range("A2"), _
shtOld.Cells(RangeFound(rngOld, , rngOld.Cells(1)).Row, "A"))
'//SAA
Set rngNew = shtNew.Range(shtNew.Range("A2"), shtNew.Cells(shtNew.Rows.Count, "D"))
Set rngNew = shtNew.Range(shtNew.Range("A2"), _
shtNew.Cells(RangeFound(rngNew, , rngNew.Cells(1)).Row, "A"))

zaboo9
07-13-2010, 07:30 AM
It's done! Thank you so much for the help GTO, I was able to modify the code you gave me to give me exactly what I need. I added two input boxes to tell the amount of rows that are in "Old" and "New" and then add that to the range code, and then I deleted the loop through "New" because it was throwing an error (And I just need matches, so though a redunant test would be nice, it's not essential.)

Here's the final code:
Option Explicit
Sub exa()
Dim _
rngOld As Range, _
rngNew As Range, _
a As Variant, _
i As Long, _
oldRows As Integer, _
newRows As Integer
oldRows = InputBox("How many rows in Old?")
newRows = InputBox("How many rows in New?")


'// Set a base range to search for the last row of data, as we cannot depend upon //
'// there being a MJ Num in the last record. //
Set rngOld = shtOld.Range(shtOld.Range("A2"), shtOld.Cells(oldRows, "Q"))
'// Set our range based on finding the last true row from above. //
Set rngOld = shtOld.Range(shtOld.Range("A2"), _
shtOld.Cells(RangeFound(rngOld, , rngOld.Cells(1)).Row, "A"))
'//SAA
Set rngNew = shtNew.Range(shtNew.Range("A2"), shtNew.Cells(newRows, "V"))
Set rngNew = shtNew.Range(shtNew.Range("A2"), _
shtNew.Cells(RangeFound(rngNew, , rngNew.Cells(1)).Row, "A"))

'// IF I have this right (a bit chancy at best), I think I am using Application.MATCH//
'// to either find each val (or that is, the row in the array), which would return a//
'// TRUE for NOT ISERROR, or, return a FALSE if not found or an error due to an //
'// empty string being supplied. //

'For i = 1 To UBound(rngOld.Value, 1)
For i = 1 To UBound(rngOld.Value, 1)
If Not IsError(Application.Match(rngOld.Value(xlRangeValueDefault)(i, 1), rngNew, 0)) Then
rngOld.Cells(i).EntireRow.Copy _
shtMatchOld.Cells( _
RangeFound( _
shtMatchOld.Range(shtMatchOld.Range("A1"), _
shtMatchOld.Cells(shtMatchOld.Rows.Count, "H") _
), , _
shtMatchOld.Cells(1) _
).Row, 1).Offset(1)
Else
rngOld.Cells(i).EntireRow.Copy _
shtNoMatchOld.Cells( _
RangeFound(shtNoMatchOld.Range(shtNoMatchOld.Range("A1"), _
shtNoMatchOld.Cells(shtNoMatchOld.Rows.Count, "H") _
), , shtNoMatchOld.Cells(1) _
).Row, 1).Offset(1)
End If
Next

End Sub

Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function


Thanks again!

GTO
07-13-2010, 08:22 AM
Hi Zaboo,

Sorry for the delay in responding. I lost track of this for a bit.

I believe the error just to be a silly mistake on my part. At the start of the last loop, change:

'//oversight: needs to run to upper bound of rngNew.Value
For i = 1 To UBound(rngNew.Value, 1)


I am not sure about post #14.

Reference #15: I'm not exactly sure how using an input box would help. I haven't thought through this, but it would seem to me that the search would no longer work properly, as it wouldn't look through all records.

Does that make sense, or am I missing something?

Finally - as I mentioned at #10, I think we can make this run well faster if we take just the values, rather than copying. I am also confident that we can use another method to better the speed over Application.Match while running through so many rows.

Before doing so, please refresh my memory and give me a bit of info:

The MJ number is the nearest thing we have to a unique identifier.
If the MJ Number in the Old sheet is not found in the New sheet, we want it listed in the NoMatch Old sheet (and visa versa)
The same holds true for where the MJ Number is missing.
What are the actual last columns in both the New and Old sheets? The example wb you have posted should be fine, but we want the find the last row searching all columns in the real wb that may have data.Mark

GTO
07-13-2010, 08:25 AM
OOPS.

I must have not checked before entering hitting the Post button. I am glad you got it working, and if it is satisfactory, that is fine.

See my comments at the last post though, as if you want further improvements, I think there are substantial ones to be made.

Mark

PS - you should be able to edit your last post. Surround the code with '...your code here... tags and it will be much easier to read.

zaboo9
07-14-2010, 02:01 PM
Thank you for this line of code! For i = 1 ToUBound(rngNew.Value, 1) It solved that problem for me.

I’ll paste “final” code I have below (including a code to clear the result sheets, this makes it much easier during testing.) I think it all works, but if you could go over it and see if you see anything that isn’t working, that would be great.

In answer to your question:

I'm not exactly sure how using an input box would help. I haven't thought through this, but it would seem to me that the search would no longer work properly, as it wouldn't look through all records.

Does that make sense, or am I missing something?

What I have done is made it so that the input boxes will have the user input the amount of rows in “Old” (In JulyFourteenTest.xls it is 1500) and in “New” (100) and so it won’t need to even search for the last row, it will just already know the range. There can be blank cells, and it appears to still work.

In the following code, all I did was set the variable that holds the rows in the following places that I have bolded '// Set a base range to search for the last row of data, as we cannot depend upon
'// there being a MJ Num in the last record.
Set rngOld = shtOld.Range(shtOld.Range("A2"), shtOld.Cells(oldRows, "Q '// Set our range based on finding the last true row from above. //[/font]
Set rngOld = shtOld.Range(shtOld.Range("A2"), _[/font]
shtOld.Cells(RangeFound(rngOld, , rngOld.Cells(1)).Row, "A"))
'//SAA
Set rngNew = shtNew.Range(shtNew.Range("A2"), shtNew.Cells(newRows, "V"))
Set rngNew = shtNew.Range(shtNew.Range("A2"), _[/font]
shtNew.Cells(RangeFound(rngNew, , rngNew.Cells(1)).Row, "A"))
The speed of the process doesn’t matter to me, it will only run through the 100,000+ record list once a month, and it has taken between 2-3 hours, which isn’t a big deal. The only thing that matters is that the data returned is accurate.

Option Explicit

Sub modifiedExa()
Dim _
rngOld As Range, _
rngNew As Range, _
a As Variant, _
i As Long, _
oldRows As Long, _
newRows As Long

oldRows = InputBox("How many rows in Old?")
newRows = InputBox("How many rows in New?")


'// Set a base range to search for the last row of data, as we cannot depend upon //
'// there being a MJ Num in the last record. //
Set rngOld = shtOld.Range(shtOld.Range("A2"), shtOld.Cells(oldRows, "Q"))
'// Set our range based on finding the last true row from above. //
Set rngOld = shtOld.Range(shtOld.Range("A2"), _
shtOld.Cells(RangeFound(rngOld, , rngOld.Cells(1)).Row, "A"))
'//SAA
Set rngNew = shtNew.Range(shtNew.Range("A2"), shtNew.Cells(newRows, "V"))
Set rngNew = shtNew.Range(shtNew.Range("A2"), _
shtNew.Cells(RangeFound(rngNew, , rngNew.Cells(1)).Row, "A"))

'// IF I have this right (a bit chancy at best), I think I am using Application.MATCH//
'// to either find each val (or that is, the row in the array), which would return a//
'// TRUE for NOT ISERROR, or, return a FALSE if not found or an error due to an //
'// empty string being supplied. //

'For i = 1 To UBound(rngOld.Value, 1)
For i = 1 To UBound(rngOld.Value, 1)
If Not IsError(Application.Match(rngOld.Value(xlRangeValueDefault)(i, 1), rngNew, 0)) Then
rngOld.Cells(i).EntireRow.Copy _
shtMatchOld.Cells( _
RangeFound( _
shtMatchOld.Range(shtMatchOld.Range("A1"), _
shtMatchOld.Cells(shtMatchOld.Rows.Count, "H") _
), , _
shtMatchOld.Cells(1) _
).Row, 1).Offset(1)
Else
rngOld.Cells(i).EntireRow.Copy _
shtNoMatchOld.Cells( _
RangeFound(shtNoMatchOld.Range(shtNoMatchOld.Range("A1"), _
shtNoMatchOld.Cells(shtNoMatchOld.Rows.Count, "H") _
), , shtNoMatchOld.Cells(1) _
).Row, 1).Offset(1)
End If
Next

'//oversight: needs to run to upper bound of rngNew.Value
For i = 1 To UBound(rngNew.Value, 1)
If Not IsError(Application.Match(rngNew.Value(xlRangeValueDefault)(i, 1), rngOld, 0)) Then
rngNew.Cells(i).EntireRow.Copy _
shtMatchNew.Cells( _
RangeFound(shtMatchNew.Range(shtMatchNew.Range("A1"), _
shtMatchNew.Cells(shtMatchNew.Rows.Count, "D") _
), , shtMatchNew.Cells(1) _
).Row, 1).Offset(1)
Else
rngNew.Cells(i).EntireRow.Copy _
shtNoMatchNew.Cells( _
RangeFound(shtNoMatchNew.Range(shtNoMatchNew.Range("A1"), _
shtNoMatchNew.Cells(shtNoMatchNew.Rows.Count, "D") _
), , shtNoMatchNew.Cells(1) _
).Row, 1).Offset(1)
End If
Next


End Sub

Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

Sub clear()
'
' clear Macro
'
' Keyboard Shortcut: Ctrl+g
'
Sheets("NoMatch_Old").Select
Range("A2:R3000").Select
Range("R2").Activate
Selection.ClearContents
Sheets("Match_New").Select
Range("A2:V3000").Select
Range("V2").Activate
Selection.ClearContents
Sheets("Match_Old").Select
Range("A2:R3000").Select
Range("R2").Activate
Selection.ClearContents
Sheets("NoMatch_New").Select
Range("A2:V3000").Select
Range("V2").Activate
Selection.ClearContents
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A2").Select
Sheets("Match_New").Select
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A2").Select
Sheets("NoMatch_Old").Select
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A2").Select
Sheets("Match_Old").Select
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 1
Range("A2").Select
Sheets("New").Select
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Range("A2").Select
Sheets("Old").Select
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Range("A2").Select
End Sub


I created test variables in “New” which areTest10, Test20…..Test100 and put those throughout my “Old.” To keep the file under 1 MB, I kept the data set relatively small. I then went through old and made blank spaces. The numbers in old aren’t random, but when you test the program you can make up MJ Numbers in “New” and place them anywhere in “Old” and you should see them in both “Match_Old” and “Match_New.”

Hopefully this all makes sense. Let me know if you have any questions, and also if the data returned appears to be accurate.
Thanks!

GTO
07-16-2010, 05:13 AM
Greetings,

In no particular order...

Up at the top, where we are declaring/dimensioning variables, ditch the 'a', it was just a temp variable.


I’ll paste final code I have below (including a code to clear the result sheets, this makes it much easier during testing.) I think it all works, but if you could go over it and see if you see anything that isn’t working, that would be great.

I believe you'll want to read through the code a bit more thoroughly. You currently have it checking for the bottom row, using columns 'Q' and 'V' as the last columns in the first lines of the code. Your example shows column R and V as the last columns.

Also, if you elect this as the method to use, you'll want to update similarly in the 'For i = 1 to Ubound(...' loops. If you step through the code, it may be easier to discern what is happening, but in short, we are describing the range to look for the last row in.




]I'm not exactly sure how using an input box would help. I haven't thought through this, but it would seem to me that the search would no longer work properly...

What I have done is made it so that the input boxes will have the user input the amount of rows in "Old" (In JulyFourteenTest.xls it is 1500) and in "New" (100) and so it won’t need to even search for the last row, it will just already know the range. There can be blank cells, and it appears to still work.

Okay - let me modify my statement a bit. Certainly we could allow the user to set the value for the last row. So far though, I stand by that we would not want to. We are only saving two quick searches, both of which will happen much faster programattically than filling in the input boxes. My real concern however, is that should the user think it would be okay to do a 'partial', it invalidates the searching with Application.Match and hence, would return bad data.

My former comments reference searching and copying being slow, specific to searching, were reference the searching for the last row in the appropriate destination sheet, before ea row is copied over.


I created test variables in "New" which areTest10, Test20..Test100 and put those throughout my "Old." To keep the file under 1 MB, I kept the data set relatively small. I then went through old and made blank spaces. The numbers in old aren’t random, but when you test the program you can make up MJ Numbers in "New" and place them anywhere in "Old" and you should see them in both "Match_Old" and "Match_New."

Hopefully this all makes sense. Let me know if you have any questions, and also if the data returned appears to be accurate.

Thanks!

I am guessing that you were going to post a larger example but did not. Using the wb at Post#13, a quck check, but it seemed accurate.

I did catch that as its once a month, speed was not a concern. That said, 100,000 records means 100,000 searches for a new bottom row, and 100,000 uses of Application.Match, ea use of which is running through a butt load of rows. So... would you mind trying this as an alternate? Please test against a junk copy of a full set of records. While not perfect, and you could re-use some of the variables within, I wrote in a hopefully easy to follow manner. I think that you will see a notable improvement.


Option Explicit

Sub exa2()
Dim _
aryOldVals As Variant, NewDIC As Object, _
aryNewVals As Variant, OldDIC As Object, _
aryMatchNew As Variant, rngCol As Range, _
aryMatchOld As Variant, rngRow As Range, _
aryNoMatchNew As Variant, rngOld As Range, _
aryNoMatchOld As Variant, rngNew As Range, _
aryMatchNewOutput As Variant, rngNewMatch As Range, _
aryNoMatchNewOutput As Variant, rngNewNoMatch As Range, _
aryMatchOldOutput As Variant, rngOldMatch As Range, _
aryNoMatchOldOutput As Variant, rngOldNoMatch As Range, _
x As Long, y As Long, _
i As Long, laryCol As Long, _
laryRow As Long, laryRow2 As Long


Set rngCol = RangeFound(SearchRange:= _
shtOld.Range( _
shtOld.Range("A2"), _
shtOld.Cells(shtOld.Rows.Count, shtOld.Columns.Count) _
), _
StartingAfter:=shtOld.Range("A2"), _
SearchRowCol:=xlByColumns)

Set rngRow = RangeFound(SearchRange:= _
shtOld.Range( _
shtOld.Range("A2"), _
shtOld.Cells(shtOld.Rows.Count, shtOld.Columns.Count) _
), _
StartingAfter:=shtOld.Range("A2"), _
SearchRowCol:=xlByRows)

Set rngOld = shtOld.Range(shtOld.Range("A2"), shtOld.Cells(rngRow.Row, rngCol.Column))

Set rngCol = RangeFound(SearchRange:= _
shtNew.Range( _
shtNew.Range("A2"), _
shtNew.Cells(shtNew.Rows.Count, shtNew.Columns.Count) _
), _
StartingAfter:=shtNew.Range("A2"), _
SearchRowCol:=xlByColumns)

Set rngRow = RangeFound(SearchRange:= _
shtNew.Range( _
shtNew.Range("A2"), _
shtNew.Cells(shtNew.Rows.Count, shtNew.Columns.Count) _
), _
StartingAfter:=shtNew.Range("A2"), _
SearchRowCol:=xlByRows)

Set rngNew = shtNew.Range(shtNew.Range("A2"), shtNew.Cells(rngRow.Row, rngCol.Column))

aryOldVals = rngOld.Value
aryNewVals = rngNew.Value

Set NewDIC = CreateObject("Scripting.Dictionary")
Set OldDIC = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(aryOldVals, 1)
If Not aryOldVals(i, 1) = Empty Then
OldDIC.Item(aryOldVals(i, 1)) = aryOldVals(i, 1)
End If
Next

For i = 1 To UBound(aryNewVals)
If Not aryNewVals(i, 1) = Empty Then
NewDIC.Item(aryNewVals(i, 1)) = aryNewVals(i, 1)
End If
Next

ReDim aryMatchNew(1 To UBound(aryNewVals, 2), 1 To UBound(aryNewVals, 1))
ReDim aryNoMatchNew(1 To UBound(aryNewVals, 2), 1 To UBound(aryNewVals, 1))
ReDim aryMatchOld(1 To UBound(aryOldVals, 2), 1 To UBound(aryOldVals, 1))
ReDim aryNoMatchOld(1 To UBound(aryOldVals, 2), 1 To UBound(aryOldVals, 1))

laryCol = 0: laryRow = 0: laryRow2 = 0
For i = 1 To UBound(aryOldVals, 1)
If NewDIC.Exists(aryOldVals(i, 1)) Then
laryRow = laryRow + 1
For laryCol = 1 To UBound(aryOldVals, 2)
aryMatchOld(laryCol, laryRow) = aryOldVals(i, laryCol)
Next
Else
laryRow2 = laryRow2 + 1
For laryCol = 1 To UBound(aryOldVals, 2)
aryNoMatchOld(laryCol, laryRow2) = aryOldVals(i, laryCol)
Next

End If
Next

laryCol = 0: laryRow = 0: laryRow2 = 0
For i = 1 To UBound(aryNewVals, 1)
If OldDIC.Exists(aryNewVals(i, 1)) Then
laryRow = laryRow + 1
For laryCol = 1 To UBound(aryNewVals, 2)
aryMatchNew(laryCol, laryRow) = aryNewVals(i, laryCol)
Next
Else
laryRow2 = laryRow2 + 1
For laryCol = 1 To UBound(aryNewVals, 2)
aryNoMatchNew(laryCol, laryRow2) = aryNewVals(i, laryCol)
Next

End If
Next

ReDim Preserve aryMatchOld(1 To UBound(aryOldVals, 2), 1 To laryRow)
ReDim Preserve aryNoMatchOld(1 To UBound(aryOldVals, 2), 1 To laryRow2)
ReDim Preserve aryMatchNew(1 To UBound(aryNewVals, 2), 1 To laryRow)
ReDim Preserve aryNoMatchNew(1 To UBound(aryNewVals, 2), 1 To laryRow2)

ReDim aryMatchNewOutput(1 To UBound(aryMatchNew, 2), 1 To UBound(aryMatchNew, 1))
ReDim aryNoMatchNewOutput(1 To UBound(aryNoMatchNew, 2), 1 To UBound(aryNoMatchNew, 1))
ReDim aryMatchOldOutput(1 To UBound(aryMatchOld, 2), 1 To UBound(aryMatchOld, 1))
ReDim aryNoMatchOldOutput(1 To UBound(aryNoMatchOld, 2), 1 To UBound(aryNoMatchOld, 1))

For x = 1 To UBound(aryMatchNewOutput, 1)
For y = 1 To UBound(aryMatchNewOutput, 2)
aryMatchNewOutput(x, y) = aryMatchNew(y, x)
Next
Next

For x = 1 To UBound(aryNoMatchNewOutput, 1)
For y = 1 To UBound(aryNoMatchNewOutput, 2)
aryNoMatchNewOutput(x, y) = aryNoMatchNew(y, x)
Next
Next

For x = 1 To UBound(aryMatchOldOutput, 1)
For y = 1 To UBound(aryMatchOldOutput, 2)
aryMatchOldOutput(x, y) = aryMatchOld(y, x)
Next
Next

For x = 1 To UBound(aryNoMatchOldOutput, 1)
For y = 1 To UBound(aryNoMatchOldOutput, 2)
aryNoMatchOldOutput(x, y) = aryNoMatchOld(y, x)
Next
Next

Set rngNewMatch = _
shtMatchNew.Range("A2").Resize(UBound(aryMatchNewOutput, 1), _
UBound(aryMatchNewOutput, 2))
Set rngNewNoMatch = _
shtNoMatchNew.Range("A2").Resize(UBound(aryNoMatchNewOutput, 1), _
UBound(aryNoMatchNewOutput, 2))
Set rngOldMatch = _
shtMatchOld.Range("A2").Resize(UBound(aryMatchOldOutput, 1), _
UBound(aryMatchOldOutput, 2))
Set rngOldNoMatch = _
shtNoMatchOld.Range("A2").Resize(UBound(aryNoMatchOldOutput, 1), _
UBound(aryNoMatchOldOutput, 2))
With rngNewMatch
.Value = aryMatchNewOutput
'// pretty up interior, borders, etc here.
End With

rngNewNoMatch.Value = aryNoMatchNewOutput
rngOldMatch.Value = aryMatchOldOutput
rngOldNoMatch.Value = aryNoMatchOldOutput
End Sub

Hope that helps,

Mark

PS - For the clearing cells between tests bit, once you have recorded a macro, you can generally see what belongs to what , and ditch quite a bit of unnecessary stuff :)
Sub QuickClear()
Worksheets("NoMatch_Old").Range("A2:R3000").ClearContents
Worksheets("Match_New").Range("A2:V3000").ClearContents
Worksheets("Match_Old").Range("A2:R3000").ClearContents
Worksheets("NoMatch_New").Range("A2:V3000").ClearContents
End Sub

zaboo9
07-16-2010, 07:25 AM
Thank you for all of the information. I'm trying to test the code on "TestTuesday" and on my actual data, but I'm getting an error screen on both that says, "Compile Error: Sub or Function not defined" and it is highlighting "RangeFound" in this code: Set rngCol = RangeFound(SearchRange:= _

I searched and searched and couldn't find how to fix this, the closest thing I found was enabling the reference "Excellink," However I don't have that option to enable. Do you know what it would be doing this? I tried in both .xls and .xlsm

GTO
07-16-2010, 08:10 AM
Sorry, I should have mentioned. This still uses the same function posted at #6. If you put this in the same wb that you tested before, it should already be there, so just checking... you are plunking the code in a Standard Module, right?

zaboo9
07-19-2010, 08:33 AM
Sorry, I should have mentioned. This still uses the same function posted at #6. If you put this in the same wb that you tested before, it should already be there, so just checking... you are plunking the code in a Standard Module, right?
I forgot to put the function in the code, it was an oversight on my part.


Okay - let me modify my statement a bit. Certainly we could allow the user to set the value for the last row. So far though, I stand by that we would not want to. We are only saving two quick searches, both of which will happen much faster programattically than filling in the input boxes. My real concern however, is that should the user think it would be okay to do a 'partial', it invalidates the searching with Application.Match and hence, would return bad data.

I completely agree, the user could easily mistype the row numbers, or not select all the data on purpose. Programatically finding the range is a much better idea.


I did catch that as its once a month, speed was not a concern. That said, 100,000 records means 100,000 searches for a new bottom row, and 100,000 uses of Application.Match, ea use of which is running through a butt load of rows. So... would you mind trying this as an alternate? Please test against a junk copy of a full set of records. While not perfect, and you could re-use some of the variables within, I wrote in a hopefully easy to follow manner. I think that you will see a notable improvement.
The code runs EXTREMELY fast now, thank you very much! It takes about ten seconds now instead of 2 hours. Haha.

I have 2 questions/requests:

1.
I ran the code on my test data of 61,665 rows in Old and 1,315 in New. The code looks to run perfectly and give proper data in every way but one:
NoMatch_Old ends with 1284 rows when it should end with 61,634 rows. (No_MatchNew ends with 1284 rows as well but that is correct, since there are 32 rows in Match_Old and Match_New.)
It appears that NoMatch_Old is basing its rows on NoMatch_New since they are the same numbers. I don't understand the code enough to where I feel comfortable changing the code, do you know where in the code this is causing it to not display all the NoMatch_Old rows?

2. Could you put commenting in the code in the most newbie terms possible? I can follow what is happening, but not at the level I want to when I need to explain the code to someone else.

I thank you again so much for all your help.
Cam

Note: When I refer to row totals, I am including the column header

GTO
07-20-2010, 02:00 AM
EDIT NOTE: Evidently my response is too long. The following two posts are together...
Hi Cam,


I forgot to put the function in the code, it was an oversight on my part.

Okey dokey and certainly no teasing from me (mostly cuz we're gonna see what a 'tard moment I had...)


I completely agree, the user could easily mistype the row numbers, or not select all the data on purpose. Programatically finding the range is a much better idea.

Thank you for mentioning. I usually try not to sway the OP, but just couldn't see this working out so swell...


The code runs EXTREMELY fast now, thank you very much! It takes about ten seconds now instead of 2 hours. Haha.

Wow and Yahoo! I should probably be chagrined reference my first attempt, but am mostly pleased with the results of the latter. I was convinced it would turn out markedly faster, but that is more dramatic than expected. Awfully glad you tested.



I have 2 questions/requests:

1.
I ran the code on my test data of 61,665 rows in Old and 1,315 in New. The code looks to run perfectly and give proper data in every way but one:
NoMatch_Old ends with 1284 rows when it should end with 61,634 rows. (No_MatchNew ends with 1284 rows as well but that is correct, since there are 32 rows in Match_Old and Match_New.)
It appears that NoMatch_Old is basing its rows on NoMatch_New since they are the same numbers. I don't understand the code enough to where I feel comfortable changing the code, do you know where in the code this is causing it to not display all the NoMatch_Old rows?


Ack! I found it. See the comments in the code, twas another simple goober on my part.


2. Could you put commenting in the code in the most newbie terms possible? I can follow what is happening, but not at the level I want to when I need to explain the code to someone else.

You bet. Hopefully I explain it sensibly.


I thank you again so much for all your help.
Cam

You are most welcome. Sorry about the time between responses; just staying too busy lately.


'// Inclusion of Option Explicit makes it so that variable declaration is required. //
'// From VBIDE's menu bar, Tools|Options|Editor tab|Require Variable Declaration. //
'// It will save you headaches later, by preventing mis-typed variable names from //
'// going unnoticed and having to search for them after the code blows up... //
Option Explicit

Sub ParseData()
Dim _
aryOldVals As Variant, NewDIC As Object, _
aryNewVals As Variant, OldDIC As Object, _
aryMatchNew As Variant, rngCol As Range, _
aryMatchOld As Variant, rngRow As Range, _
aryNoMatchNew As Variant, rngOld As Range, _
aryNoMatchOld As Variant, rngNew As Range, _
aryMatchNewOutput As Variant, rngNewMatch As Range, _
aryNoMatchNewOutput As Variant, rngNewNoMatch As Range, _
aryMatchOldOutput As Variant, rngOldMatch As Range, _
aryNoMatchOldOutput As Variant, rngOldNoMatch As Range, _
x As Long, y As Long, _
i As Long, laryCol As Long, _
laryRow As Long, laryRow2 As Long

'// See vba help for Find, as well as the explanation in 'RangeFound()'. In short, //
'// we are using .Find to find either the last row or last column in the true //
'// used range to set the ends (row and column) of the ranges of data we wish to //
'// snatch up. //
'// As you have already gathered, we are referring to sheets by their CodeName or //
'// Object name. Originally, I did this out of convenience, but an added benefit is//
'// that if a user changes the 'tab name', the code still runs. //
Set rngCol = RangeFound(SearchRange:= _
shtOld.Range( _
shtOld.Range("A2"), _
shtOld.Cells(shtOld.Rows.Count, shtOld.Columns.Count) _
), _
StartingAfter:=shtOld.Range("A2"), _
SearchRowCol:=xlByColumns)

Set rngRow = RangeFound(SearchRange:= _
shtOld.Range( _
shtOld.Range("A2"), _
shtOld.Cells(shtOld.Rows.Count, shtOld.Columns.Count) _
), _
StartingAfter:=shtOld.Range("A2"), _
SearchRowCol:=xlByRows)

'// After finding the last row and column that have data, we set a reference to our //
'// range. As I believe I mentioned, to my ability, I wrote the code to be clear. //
'// In actuality, as we will not be modifying either of the original/source sheets, //
'// we could skip setting 'rngOld' and 'rngNew' at this point, and simply tack on //
'// .Value to everything that is right of the equal sign in the line below, and //
'// assign it to aryOldVals like: //
'// aryOldVals = _ //
'// shtOld.Range(shtOld.Range("A2"), shtOld.Cells(rngRow.Row, rngCol.Column)) _ //
'// .Value //
Set rngOld = shtOld.Range(shtOld.Range("A2"), shtOld.Cells(rngRow.Row, rngCol.Column))

Set rngCol = RangeFound(SearchRange:= _
shtNew.Range( _
shtNew.Range("A2"), _
shtNew.Cells(shtNew.Rows.Count, shtNew.Columns.Count) _
), _
StartingAfter:=shtNew.Range("A2"), _
SearchRowCol:=xlByColumns)

Set rngRow = RangeFound(SearchRange:= _
shtNew.Range( _
shtNew.Range("A2"), _
shtNew.Cells(shtNew.Rows.Count, shtNew.Columns.Count) _
), _
StartingAfter:=shtNew.Range("A2"), _
SearchRowCol:=xlByRows)

Set rngNew = shtNew.Range(shtNew.Range("A2"), shtNew.Cells(rngRow.Row, rngCol.Column))

aryOldVals = rngOld.Value
aryNewVals = rngNew.Value

'// See vba help re: Dictionary. We create references to two new Dictionary Objects.//
'// You could use Advanced Filtering as well - I chose to build dictionaries to //
'// create collections of unique values. In our case, unique MJNumbers, discluding //
'// missing ones. //
Set NewDIC = CreateObject("Scripting.Dictionary")
Set OldDIC = CreateObject("Scripting.Dictionary")

'// If a better explanation is needed, say so - but you seem to have a grasp on //
'// principles, and may well have a grasp equal or exceeding mine as to arrays. //
'// That being the case, I'll mention this much: VBA naturally starts the base of //
'// an array at 0 for the first element of a dimension, excepting ranges (and //
'// probably some other wacky stuff I'm not recalling). Since we we plunked the //
'// vals of the ranges into dynamic variant arrays, our arrays will look like: //
'// MyArray(1 to HoweverManyRows, 1 to HoweverManyColumns) //
'// Consequently, we may safely use '1' as LBound and UBound(MyArray, WhichElement) //
'// to set the parameters of our For...Next //
'// See vba help re (L/U)Bound //
For i = 1 To UBound(aryOldVals, 1)
If Not aryOldVals(i, 1) = Empty Then
'// Barring an empty row, assign the current element in aryOldVals to the //
'// same Key in the Dictionary, and assign the same value to the .Item. //
'// See vba help re Dictionary, but in short, this seems faster to me than //
'// checking .Exists and then .Add(ing) the val to the collection. //
OldDIC.Item(aryOldVals(i, 1)) = aryOldVals(i, 1)
End If
Next

For i = 1 To UBound(aryNewVals, 1)
If Not aryNewVals(i, 1) = Empty Then
NewDIC.Item(aryNewVals(i, 1)) = aryNewVals(i, 1)
End If
Next

'// For the moment, let's pretend that there are only four possible types of //
'// arrays in the universe. //
'// //
'// (1) A one-dimensional/horizontal array, (2) a two-dimensional array consisting //
'// of one or more rows and one or more columns (For the mind's eye, picture the //
'// spreadsheet.), (3) a three-dimensional array that we could reasonably picture as//
'// a cube, or (4) other arrays that only people needing psychological help might //
'// use. //
'// //
'// As we are dealing with worksheets, ie - a two-dimensional shape, and we'd not //
'// like to give up part of our paychecks for psychotropics, we'll concentrate on //
'// one and two-dimensional arrays. //
'// //
'// See vba help:ReDim and keyword Preserve. As we can only Redim (resize) the last//
'// dimension of an array and keep the current vals (Preserve), if we need to resize//
'// and preserve a two-dimensional array, wherein we're not sure of how many rows //
'// we will end up with, we need to lay the array over on its side (transpose), so //
'// that when we eventually trim or add columns (the second dimension), we are //
'// actually or eventually (after transposing back to the original 'shape' of the //
'// array) trimming or adding rows. //
'// //
'// Thus - we will dimension these arrays 'sideways' and oversize them initially. //
'// In short, ea array has the number of columns that our original array had in //
'// rows and visa-versa. //
ReDim aryMatchNew(1 To UBound(aryNewVals, 2), 1 To UBound(aryNewVals, 1))
ReDim aryNoMatchNew(1 To UBound(aryNewVals, 2), 1 To UBound(aryNewVals, 1))
ReDim aryMatchOld(1 To UBound(aryOldVals, 2), 1 To UBound(aryOldVals, 1))
ReDim aryNoMatchOld(1 To UBound(aryOldVals, 2), 1 To UBound(aryOldVals, 1))

'// Now we will use four counters (including 'i' in the For...Next loop) to build //
'// our 'on their sides' arrays. I think you'll find stepping-thru (F8) this bit to//
'// be the easiest way to catch what is happening. In gist, we run through the first//
'// dimension (column) of our arrays (ie-checking MJNumbers) and see which vals exist//
'// in the 'opposing' sheet via the dictionary collection we built, to determine //
'// which sheet a given record should end up in. You can then see how we are fill- //
'// ing vals in a transposed by noting where 'laryCol' is in the two arrays. //
laryCol = 0: laryRow = 0: laryRow2 = 0
For i = 1 To UBound(aryOldVals, 1)
If NewDIC.Exists(aryOldVals(i, 1)) Then
laryRow = laryRow + 1
For laryCol = 1 To UBound(aryOldVals, 2)
aryMatchOld(laryCol, laryRow) = aryOldVals(i, laryCol)
Next
Else
laryRow2 = laryRow2 + 1
For laryCol = 1 To UBound(aryOldVals, 2)
aryNoMatchOld(laryCol, laryRow2) = aryOldVals(i, laryCol)
Next

End If
Next

'// NOTE: This, by the way, is where I goobered up the code before. After all done//
'// testing, I got into a bit of a tidying-up frenzy and while correcting //
'// layout/indentation/etc, moved this down below the following loop. While it //
'// looked ever so pretty, it of course did not work... //

'// Okay - after that admission, this is where we trim up the array to just fit the //
'// vals assigned. //
ReDim Preserve aryMatchOld(1 To UBound(aryOldVals, 2), 1 To laryRow)
ReDim Preserve aryNoMatchOld(1 To UBound(aryOldVals, 2), 1 To laryRow2)

laryCol = 0: laryRow = 0: laryRow2 = 0
For i = 1 To UBound(aryNewVals, 1)
If OldDIC.Exists(aryNewVals(i, 1)) Then
laryRow = laryRow + 1
For laryCol = 1 To UBound(aryNewVals, 2)
aryMatchNew(laryCol, laryRow) = aryNewVals(i, laryCol)
Next
Else
laryRow2 = laryRow2 + 1
For laryCol = 1 To UBound(aryNewVals, 2)
aryNoMatchNew(laryCol, laryRow2) = aryNewVals(i, laryCol)
Next

End If
Next

ReDim Preserve aryMatchNew(1 To UBound(aryNewVals, 2), 1 To laryRow)
ReDim Preserve aryNoMatchNew(1 To UBound(aryNewVals, 2), 1 To laryRow2)

'// Note that there is no Preserve as we are sizing empty arrays to fit the previous//
'// arrays, again transposed, this time back to how we want it to layout on the //
'// destination sheets. Eyes hurting yet? //
ReDim aryMatchNewOutput(1 To UBound(aryMatchNew, 2), 1 To UBound(aryMatchNew, 1))
ReDim aryNoMatchNewOutput(1 To UBound(aryNoMatchNew, 2), 1 To UBound(aryNoMatchNew, 1))
ReDim aryMatchOldOutput(1 To UBound(aryMatchOld, 2), 1 To UBound(aryMatchOld, 1))
ReDim aryNoMatchOldOutput(1 To UBound(aryNoMatchOld, 2), 1 To UBound(aryNoMatchOld, 1))

'// Assign vals from the 'layed over' arrays to our output arrays... //
For x = 1 To UBound(aryMatchNewOutput, 1)
For y = 1 To UBound(aryMatchNewOutput, 2)
aryMatchNewOutput(x, y) = aryMatchNew(y, x)
Next
Next

For x = 1 To UBound(aryNoMatchNewOutput, 1)
For y = 1 To UBound(aryNoMatchNewOutput, 2)
aryNoMatchNewOutput(x, y) = aryNoMatchNew(y, x)
Next
Next

For x = 1 To UBound(aryMatchOldOutput, 1)
For y = 1 To UBound(aryMatchOldOutput, 2)
aryMatchOldOutput(x, y) = aryMatchOld(y, x)
Next
Next

For x = 1 To UBound(aryNoMatchOldOutput, 1)
For y = 1 To UBound(aryNoMatchOldOutput, 2)
aryNoMatchOldOutput(x, y) = aryNoMatchOld(y, x)
Next
Next

'// Size our destination ranges to match the size of the output arrays. //
Set rngNewMatch = _
shtMatchNew.Range("A2").Resize(UBound(aryMatchNewOutput, 1), _
UBound(aryMatchNewOutput, 2))
Set rngNewNoMatch = _
shtNoMatchNew.Range("A2").Resize(UBound(aryNoMatchNewOutput, 1), _
UBound(aryNoMatchNewOutput, 2))
Set rngOldMatch = _
shtMatchOld.Range("A2").Resize(UBound(aryMatchOldOutput, 1), _
UBound(aryMatchOldOutput, 2))
Set rngOldNoMatch = _
shtNoMatchOld.Range("A2").Resize(UBound(aryNoMatchOldOutput, 1), _
UBound(aryNoMatchOldOutput, 2))
With rngNewMatch
.Value = aryMatchNewOutput
'// pretty up interior, borders, etc here.
End With

rngNewNoMatch.Value = aryNoMatchNewOutput
rngOldMatch.Value = aryMatchOldOutput
rngOldNoMatch.Value = aryNoMatchOldOutput
End Sub

GTO
07-20-2010, 02:03 AM
[Part two...]


'// See vba help re Find. This is just a function I use to supply 'default' arguments //
'// to the Find method. Between being a crappy/slow typist and blonde/forgetful, this //
'// just seems convenient to me, as it seems I most oft use Find to locate the //
'// bottom/rightmost row/column containing data. //
Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

Phew! Hope that all made sense.

Mark

zaboo9
07-21-2010, 01:57 PM
Mark,

Thank you thank you thank you!!! The code works perfectly, it finds every single match, and shows all the instances where there isn't a match as well. This is exactly what I needed/wanted.



You are most welcome. Sorry about the time between responses; just staying too busy lately.

That is not a problem at all, I am very much appreciative of the trememendous effort you put forth in helping me on this; and I know that coding isn't a quick process to say the least.


Phew! Hope that all made sense.
The commenting is extremely informative, and very helpful. I am studying through it, and will look up the references that you mentioned, as well as follow along on the code with F8 and by adding watches to variables.

Once again, thank you so much. I have learned so much about VBA through this whole process, and realize even more how much there is to learn. Have a great day!
Cam