PDA

View Full Version : Match and copy, unique condition



anep67
02-01-2013, 07:04 AM
Hello to all gurus here..

I am quite new to macros and vba and cracking my head to solve this problem but I don't know whether it is possible.

The code suppose to get the first number and match to the rest of the numbers according to the conditions stated below and copy the matching numbers in column B.

Example:

Column A Column B
1234 1234
2456 4312
4312 1234
5826 1294
1294 1234
4326 4326

The above is exactly what I wanted. It means the code get the first number from Column A and find matching numbers in column A and then copy both in Column B. Then it goes to second number in Column A and do the same again until the end. However the matching condition is as follows:

a) the exact number ie 1234
b) all the permutation ie 1432, 1324, 2314 etc..
c) 123?, 12?4, 1?34, ?234 (ie 1254, 9234, 1238 etc)
d) backward - 432?, 43?1, 4?21, ?321 (ie 4329, 8321, 4921 etc)

Thank you..

p45cal
02-01-2013, 05:40 PM
It would be nice to see what coding you've already done, since this forum is really to help people with their vba rather than a free code-writing service. That said, below are a set of functions and 2 subs.
The two subs (blah and blah2) are variations on a theme, blah comparing every cell in column A with every cell in column A making an exception for the same cell. Blah2 works down each cell in column A, but only makes comparisons with all the cells below that cell. I haven't bothered checking if blah gives more than just a duplicate of the results of blah2 - I leave it to you to check for yourself.

I haven't done anything to cater for leading zeroes. Again, for you to check if it works.

To try this, run either blah or blah2, all the other functions should be present in the same workbook in a standard module. To test this, all the code can go into a single standard code-module.

You should adust the first line of blah/2 to match the cells you want to test. It doesn't have to be column A, but it should be a single column of cells. Results are written to the sheet starting in the cell to the right of the first cell and working down. It will overwrite anything there. The first of each pair of results is in bold.

Anyway, the code:Sub blah2()
Set testrange = Range("A12:A17")
Set DestCell = Cells(testrange.Row, testrange.Column + 1)
For Each cll In testrange.Cells
Set CellsBelow = Intersect(testrange, cll.Offset(1).Resize(testrange.Rows.Count))
If Not CellsBelow Is Nothing Then
For Each celle In Intersect(testrange, cll.Offset(1).Resize(testrange.Rows.Count))
If cll.Address <> celle.Address Then
If MeetsACondition(CStr(cll), CStr(celle)) Then
DestCell.Value = cll.Value
DestCell.Font.Bold = True
DestCell.Offset(1).Value = celle.Value
Set DestCell = DestCell.Offset(2)
End If
End If
Next celle
End If
Next cll
'consider leading zeroes
End Sub

Sub blah()
Set testrange = Range("A12:A17")
Set DestCell = Cells(testrange.Row, testrange.Column + 1)
For Each cll In testrange.Cells
For Each celle In testrange.Cells
If cll.Address <> celle.Address Then
If MeetsACondition(CStr(cll), CStr(celle)) Then
DestCell.Value = cll.Value
DestCell.Font.Bold = True
DestCell.Offset(1).Value = celle.Value
Set DestCell = DestCell.Offset(2)
End If
End If
Next celle
Next cll
'consider leading zeroes
End Sub
Function MeetsACondition(templateStr As String, TestStr As String) As Boolean
If Len(templateStr) = Len(TestStr) Then
If templateStr = TestStr Then
MeetsACondition = True
Exit Function
End If
If IsPermutation(templateStr, TestStr) Then
MeetsACondition = True
Exit Function
End If
If IsOneMissing(templateStr, TestStr) Then
MeetsACondition = True
Exit Function
End If
End If
End Function
Function IsPermutation(templateStr As String, TestStr As String) As Boolean
mylen = Len(templateStr)
For I = 1 To mylen
If InStr(templateStr, Mid(TestStr, I, 1)) < 1 Or InStr(TestStr, Mid(templateStr, I, 1)) < 1 Then Exit For
Next I
If I = mylen + 1 Then
For I = 1 To mylen
ChrToCount = Mid(templateStr, I, 1)
If Len(Replace(templateStr, ChrToCount, "")) <> Len(Replace(TestStr, ChrToCount, "")) Then Exit For
Next I
End If
IsPermutation = (I = mylen + 1)
End Function
Function IsOneMissing(templateStr As String, TestStr As String) As Boolean
mylen = Len(templateStr)
templateStrRev = ReverseString(templateStr)
For I = 1 To mylen
a = Mid(templateStr, 1, I - 1) & "?" & Mid(templateStr, I + 1, mylen - I)
b = Mid(templateStrRev, 1, I - 1) & "?" & Mid(templateStrRev, I + 1, mylen - I)

If TestStr Like a Or TestStr Like b Then
IsOneMissing = True
Exit For
End If
Next I
End Function
Function ReverseString(theString As String) As String
For I = Len(theString) To 1 Step -1
ReverseString = ReverseString & Mid(theString, I, 1)
Next I
End Function

anep67
02-01-2013, 08:38 PM
Thank you very much p45cal. Honestly I haven't done anything since I don't even know where to start. Anyway thank you and I will run the code first and try to understand how it works.

Thank you you just saved few years of my wasted time doing it manually.

anep67
02-01-2013, 11:31 PM
Hi p45cal,

Thank you very much. It works perfectly as I requested. Now I will need to adapt it to the actual environment. I don't know how but I will study line by line of your code and do modification as required.

Again Thank you... you are really a VBA GURU...

anep67
02-03-2013, 09:07 AM
Hi p45cal, Good day to you.
Need another favour from you. I am using your blah2 code and is working fine. However I am stuck in this problem. Using the same thing how to indicate only certain cells to match. For example I want cell A1 to compare the rest of the list then cell A2 and A3 compare from A4 to the end and then A4 to A10 compare from A11 to the rest of the list etc..

These are the some of it (just say the list is from A1 to A75):
1) Cell A1 to compare from A2 to A75
2) Cell A2,A3 compare from A4 to A75 (means A2 and A3 will start comparing from A4 onwards)
3) Cell A4 to compare from A5 to A75
4) Cell A5 to A22 to compare from A23 to A75
and the list goes on.....
Many thanks and may GOD bless you

p45cal
02-03-2013, 09:26 AM
These are the some of it (just say the list is from A1 to A75):
1) Cell A1 to compare from A2 to A75
2) Cell A2,A3 compare from A4 to A75 (means A2 and A3 will start comparing from A4 onwards)
3) Cell A4 to compare from A5 to A75
4) Cell A5 to A22 to compare from A23 to A75
and the list goes on.....
Many thanks and may GOD bless you
Well it's possible with a long list within the code, or perhaps some data on the sheet, but is there any logic behind why those specific comparisons?

anep67
02-03-2013, 09:49 AM
Hi p45cal,

Thanks for the prompt reply. Actually I am working in auditing firm and every time I do auditing I receive several excel sheet with full of numbers and I have to compare the invoice numbers with the value, stocks etc..

Most of the time there will be typo error and I have to dig a lot of files which will make me go insane.

So with this method I can do a search for invoice numbers, stocks, etc even if the worker typed wrongly.

The reason for my recent request is the invoice number might refer to stock "A" worksheet or "B" or "C" and so on. What I do is copy all the figures in one sheet and run your code.

This may sound stupid to you but hey this is much better than doing it manually.

Thanks..

p45cal
02-03-2013, 10:11 AM
Since you're doing this on different data would the following work as a method to tell the code what to compare?
First, it assumes that all comparisons all go down to A75. Is that right?
Second, put in column C the first row number that the cell in column A of the same row should begin comparisons with.
Where there are blanks, means the default, which is comparisons start at the cell below that row.
So for your specific example it would look like this before you ran the macro:
9484

anep67
02-03-2013, 10:32 AM
Okay, just say I have a list of Invoice numbers, stock balance A, stock balance b and stock balance C and just assume that all the numbers is 4 digits (including 0). So I paste all the numbers in Column A.

Means:
A1 to A20 is Invoice
A21 to A50 is Stock A
A51 to A60 is Stock B
A61 to A 75 is Stock C

Now I wanted to search for invoice number in cell A15 to the stocks list or
I wanted to search for Invoice in Cell A5 to A15 to the stock list etc..

Back to my earlier question. The code is the same as blah2 but instead of comparing number below we indicate what to compare and the result is pasted on the next column exactly as blah2.

Hope you understand.

p45cal
02-03-2013, 11:21 AM
I'm only asking about whether my idea could be something you could work with. I haven't written code yet to do it. Using your example:
A1 to A20 is Invoice
A21 to A50 is Stock A
A51 to A60 is Stock B
A61 to A 75 is Stock
and:
I wanted to search for Invoice in Cell A5 to A15 to the stock list.

Then you would add data to column C as follows:
9485
You'd then select cells A5:A75 and run the (adjusted) macro, which would then, starting from A5, run down column A, look at column C to determine what row to start making comparisons with. We could also arrange it so that if column C was blank, no comparisons were made with the number in Column A with anything below that row. We could also arrange it so that column D stipulated the last row comparisons were to be made with the number in column A of that row.

I confess to not fully understanding what you're after.

As an aside, might it not be better to drop the results across the sheet, so that all the results in a given row pertain to column A in that row?

anep67
02-03-2013, 12:10 PM
Now I am really confused.. I appreciate your idea but it sounds too complicated to me and I would need to adjust the code on case basis.

Okay lets forget everything and back to my original post.

Example:

Column A Column B
1234 1234
2456 4312
4312 1234
5826 1294
1294 1234
4326 4326

From the example above. The first Cell ie 1234 will compare number row below until the end and followed by 2456 and so on. But now I want 1234 to search from Cell A5 until the end. Then 2456 to search from Cell A6 until the end and so on.

I just want you to give me an example of the code so that it search a fixed range rather than the whole list. Just as below:

1) Cell A1 to search from A2 to A75
2) Cell A2 and A3 search from A4 to A75 (means A2 and A3 will start searching from A4 onwards)
3) Cell A4 to search from A5 to A75
4) Cell A5 to A22 to search from A23 to A75

When the code run it will get value from A1 and look for match from A2 to A75 then copy both value in Column B then it will get value from A2 look for match in A4 onwards (not A3) then A3 and so on...

Thanks for your time..

p45cal
02-03-2013, 03:48 PM
try, without adjusting the code below, just running it:
Sub blah3()
Set TemplateRng = Application.InputBox("Select the 1st range of cells", Type:=8)
Set testrange = Application.InputBox("Select the 2nd range of cells", Type:=8)
Set DestCell = Application.InputBox("Select 1 cell as the start of the results", Type:=8)
For Each cll In TemplateRng.Cells
If Not testrange Is Nothing Then
For Each celle In testrange.Cells
If cll.Address <> celle.Address Then
If MeetsACondition(CStr(cll), CStr(celle)) Then
DestCell.Value = cll.Value
DestCell.Font.Bold = True
DestCell.Offset(1).Value = celle.Value
Set DestCell = DestCell.Offset(2)
End If
End If
Next celle
End If
Next cll
'consider leading zeroes
End Sub

anep67
02-03-2013, 10:54 PM
Thanks but when I run the code I can only do 1 search. What if i have more than 1? Instead of input box can we do a fixed range?

For example cell A1 search from A2 onward, A2 and A3 search from A4 onwards, A4 search from A22 onwards ans so on..

I have a reason behind it and really difficult to explain to you.

Thanks..

p45cal
02-06-2013, 10:57 AM
try:
Sub blah4()
TemplateRanges = Array("A1", "A2:A3", "A4")
TestRanges = Array("A2:A75", "A4:A75", "A22:A75")
For i = LBound(TemplateRanges) To UBound(TemplateRanges)
Set TemplateRng = Range(TemplateRanges(i))
Set testrange = Range(TestRanges(i))
Set DestCell = TemplateRng.Cells(1).Offset(, 1)
For Each cll In TemplateRng.Cells
If Not testrange Is Nothing Then
For Each celle In testrange.Cells
If cll.Address <> celle.Address Then
If MeetsACondition(CStr(cll), CStr(celle)) Then
DestCell.Value = cll.Value
DestCell.Font.Bold = True
DestCell.Offset(1).Value = celle.Value
Set DestCell = DestCell.Offset(2)
End If
End If
Next celle
End If
Next cll
Next i
'consider leading zeroes
End Subuntested.
But be aware that this is almost certain to overwrite results.

anep67
02-07-2013, 03:12 AM
Thanks..

You are right. When I run the code it copies the first match then skipped two lines and the rest are bold and some numbers missing. I guess you are right it overwrites the result.

p45cal
02-07-2013, 03:46 AM
earlier:
As an aside, might it not be better to drop the results across the sheet, so that all the results in a given row pertain to column A in that row?

anep67
02-07-2013, 09:26 AM
Yup I totally agreed with you.. so which one should I change..

Thanks

p45cal
02-07-2013, 10:25 AM
Sub blah5()
'A1 search from A2 onward, A2 and A3 search from A4 onwards, A4 search from A22 onwards ans so on..
TemplateRanges = Array("A1", "A2:A3", "A4") 'as long as these ranges don't overlap there will be no overlap of results.
TestRanges = Array("A2:A75", "A4:A75", "A22:A75")
For i = LBound(TemplateRanges) To UBound(TemplateRanges)
Set TemplateRng = Range(TemplateRanges(i))
TemplateRng.Select
Set testrange = Range(TestRanges(i))
testrange.Select
For Each cll In TemplateRng.Cells
Set DestCell = cll.Offset(, 1)
DestCell.Select
If Not testrange Is Nothing Then
For Each celle In testrange.Cells
If cll.Address <> celle.Address Then
If MeetsACondition(CStr(cll), CStr(celle)) Then
DestCell.Value = celle.Value
Set DestCell = DestCell.Offset(, 1)
End If
End If
Next celle
End If
Next cll
Next i
End Sub

anep67
02-07-2013, 11:15 AM
I have attached a test file. When I ran the code the result is haywire.
Don't understand why..

Thanks

p45cal
02-07-2013, 02:23 PM
It seems fairly good. The results now are on the same row, so no need to duplicate what's in column A every time.
I did notice that most of the cells in column A were formatted as text. Those which weren't, were zeroes, so I made those 0000 and formatted those cells as text like the rest of the column. It isn't really necessary to do this.
I made one small change to the code:
Destcell.Value = celle.Value
becomes:
celle.Copy Destcell
which just carries the formatting over as well as the number.

So in what way is it haywire?

anep67
02-10-2013, 12:06 PM
Sorry Sir, my mistake. It's working fine. However in the real situation the list is very long that's why I wanted to carry over both matching numbers for easy reference. In this manner it will be difficult as I will need to refer back to the list every time. Anyway you have already help me a lot. Thank you very much..:clap::clap::thumb

p45cal
02-10-2013, 12:37 PM
Select B2 and freeze panes.