excel 2007 formula to combine like pairs

[LuGyver]

Thank you for your help!
Using excel 2007.
need to combine like pairs and keep the results in one row.

A1:AK1 holds the pairs
-The pairs are generated by a formula and are not sorted. The format is general and there are no duplicates in this row.

A2:indefinate2 (as far right as it needs to go) needs to hold the formula of which combines the pairs.
It is okay if they are, or, are not sorted in the final outcome as long as the combined results are all in one row.

Also, I could have made mistakes when I penciled the information below. Coming close to it is okay and i Hope you see the jest of it.

Example of Pairs & Combined Pairs:
- I Sorted Pairs to make it easier to see
[TABLE="class: MsoNormalTable, width: 723"]
<tbody>[TR]
[TD] 01[/TD]
[TD="width: 25"] 11[/TD]
[TD="width: 25"] 15[/TD]
[TD="width: 25"] 21[/TD]
[TD="width: 25"] 30[/TD]
[TD="width: 25"] 31[/TD]
[TD="width: 25"] 33[/TD]
[TD="width: 25"] 34[/TD]
[TD="width: 25"] 40[/TD]
[TD="width: 25"] 41[/TD]
[TD="width: 25"] 43[/TD]
[TD="width: 25"] 44[/TD]
[TD="width: 25"] 46[/TD]
[TD="width: 25"] 48[/TD]
[TD="width: 25"] 53[/TD]
[TD="width: 25"] 54[/TD]
[TD="width: 23"] 55[/TD]
[TD="width: 23"] 57[/TD]
[TD="width: 23"] 59[/TD]
[TD="width: 23"] 61[/TD]
[TD="width: 23"] 64[/TD]
[TD="width: 23"] 66[/TD]
[TD="width: 23"] 68[/TD]
[TD="width: 23"] 83[/TD]
[TD="width: 23"] 86[/TD]
[TD="width: 23"] 93[/TD]
[/TR]
</tbody>[/TABLE]

Notice there are pairs 01 30 40 all contain "0". So, the formula need to achieve 01 and 03 = 013, 01 and 04 = 014.

Penciled the rest of the like pairs out so you can see what the combined results should look like:
11 15 21 31 41 61 = 115 112 113 114 116
15 55 = 155
21 31 41 61 = 213 214 216
30 10 40 = 301 104 304
31 41 61 = 314 316
33 43 53 83 93 = 334 353 383 393
34 44 54 64 = 344 354 364
41 61 = 416
43 83 = 483
44 46 4854 = 446 445 448
46 64 = 466
48 64 = 486
53 83 93 = 538 539
54 64 = 564
66 68 86 = 668
68 83 = 683
83 31 43 53 93 = 831 834 835
83 93 = 893


I have tried different variations of sumproduct but always have to involve more than one row.
Here's one example
=IF(SUMPRODUCT(--(LEFT($A$1:$A$1,1)=LEFT(B$1))),LEFT($A$1,1)&B$1,IF(SUMPRODUCT(--(LEFT($A$1:$A$1,1)=RIGHT(B$1))),LEFT($A$1,1)&B$1,IF(SUMPRODUCT(--(RIGHT($A$1:$A$1,1)=LEFT(B$1))),RIGHT($A$1,1)&B$1,IF(SUMPRODUCT(--(RIGHT($A$1:$A$1,1)=RIGHT(B$1))),RIGHT($A$1,1)&B$1,""))))

 

[LuGyver]

No, you can still fill down the formulas in A:AT, although a macro could do that if you want. The new macro below will automatically fill in the results for the new row. If you fill down for say 3 rows then the macro will automatically fill in the results for those 3 rows.

To implement the new macro (testing in a copy of your workbook), follow these steps..
1. Right click the sheet name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Close the Visual Basic window & test by dragging the A:AT formulas down.

Think I found the issue.
Wow I had no Idea how much I did until I try to explain procedures...
Here is what I do after each new date.
1. When I open my file the first thing I do is fill the 3 lowest rows, one row each. Starting from the lowest row first, fill down one row, then 2nd lowest, fill down one row and then 3rd lowest row, fill down one row, to carry out a specific calculations.
1a. to visualize (hypothetically) Let's say:
1aa. sheet1 would have the date in column A1:A1000 with the latest date in A1000 (3rd lowest row).
1ab. below that, Row A1001:AZ1001 would have formulas starting below the prior pair area (say from AF1001 over (to say AZ1001)). These are formulas to gather specific data from history of draws prior to Row A1001 (2nd lowest row) which is where I get the new pairs.
1ac. In Row A1002, (1st lowest row) there are formula to remove duplicate pairs from AF1001:AZ1001.

2. Once those three rows are filled down one row each, I then would have the correct pairs made available for combining pairs in BA1001:?1001.
2a Keep in mind, that when Filling down Row A1000, it would bring (copy) the combined pairs (from BA1000:?1000) down to in BA1001:?1001. So the VB Code would have to clear BA1001:?1001 area only, and then combine it with the new pairs in the same row A1001.

3. Assuming two different parts to VB Code ---
3a. First part of code is only need once to fill yesterdays Row A1000 date and pairs and combined pair calculations all the way back to row, say A500. There is no need now to redo these areas any more as this is ample history to see and back test during future calculations.
3b. The 2nd VB Code says if there is combined pairs already in A500:A1000, then only need to combine pairs for row A1001 ( in BA1001:?1001).
3c. As for row A1002, I already have the formula filled across Row A1002 to automatically remove duplicates that reside in row A1001. If you like, although not necessary, in B1002:?1002 the vb code can be made to clear in BA1002:?1002 and combine the pairs with duplicates removed... Just know that there are blanks in this row that may hinder the code.

4. Therefore, once the history is logged, it would stay in A500:A1000 and Combining is now only done in Rows A1001 (you may include A1002 if no problem, but not necessary).

 

[LuGyver]

not sure where my last reply went but thankfully I saved my work. here it is again

opps found it

 

[Peter_SSs]

Sorry, I'm afraid I cannot get my head around what you have, where or what you require.

 

[LuGyver]

Sorry, I'm afraid I cannot get my head around what you have, where or what you require.

Peter you have done extraordinary work with the code and I can't ask for more.
your not the first person..., had a girlfriend like that once!

But, you showed signs of a pulse as to what I was doing, so I was just trying to make it clearer than I had prior.

If I did ask for more, the only thing, is that the code is uncontrollable. by that I mean if the sheet had a button to push when I am ready to combine, it would make all the difference.

Right now your code combines the pairs before I get rows completely filled down, then won't do any more until I close the sheet and reopen it. So, that's why i said, somewhat, that I fill down three rows first, before I need the codes help. Does that make sense?

The rest of that stuff I posted, was in case you delve further and needed more information.

I have another file/sheet that adds a new row with a button within the sheet (here's that code below) but I don't know how to implement it into the sheet for the code you have provided.

Sub AddNewDrawing()
'
' AddNewDrawing Macro
'

'
    Rows("20:20").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A21:mz21").Select
    Selection.AutoFill Destination:=Range("A20:mz21"), Type:=xlFillDefault
    Range("A20:mz21").Select
    Range("E20").Select
    Selection.ClearContents
End Sub

 

[Peter_SSs]

If I did ask for more, the only thing, is that the code is uncontrollable. by that I mean if the sheet had a button to push when I am ready to combine, it would make all the difference.

OK, let's see if we can progress that a bit. In a copy of the workbook ..
1. Delete that Worksheet_Change code
2. While in the vba window, use the Menu to Insert -> Module
3. Paste the code below into the Module that was opened in step 2.
4. Put a button on your sheet and assign the new macro to it.

This code is still written for data in columns A:AT with results to the right starting in column BA. Is that what you have?

Sub Combine_Pairs()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, x As Long, y As Long, k As Long, UBa As Long, r As Long, lrL As Long, lrR As Long
  Dim s As String
 
  lrL = Columns("A").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
  If Not IsEmpty(Range("BA1").Value) Then lrR = Columns("BA").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
  If lrL > lrR Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For r = lrR + 1 To lrL
      a = Range("A" & r & ":AT" & r).Value
      UBa = UBound(a, 2)
      ReDim b(1 To 1, 1 To 1)
      For i = 1 To UBa - 1
        s = a(1, i)
        For j = i + 1 To UBa
          x = Left(a(1, j), 1)
          y = Right(a(1, j), 1)
          If InStr(1, s, x) > 0 Or InStr(1, s, y) > 0 Then
            If InStr(1, s, x) = 0 Then s = s & x
            If InStr(1, s, y) = 0 Then s = s & y
            If Len(s) = 2 Then s = s & IIf(x > y, x, y)
            k = k + 1
            ReDim Preserve b(1 To 1, 1 To k)
            b(1, k) = s
            s = a(1, i)
          End If
        Next j
      Next i
      If k > 0 Then
        With Range("BA" & r).Resize(, k)
          .NumberFormat = "@"
          .Value = b
        End With
        k = 0
      End If
    Next r
    Application.ScreenUpdating = True
    Application.EnableEvents = True
  End If
End Sub

 

[LuGyver]

OK, let's see if we can progress that a bit. In a copy of the workbook ..
1. Delete that Worksheet_Change code
2. While in the vba window, use the Menu to Insert -> Module
3. Paste the code below into the Module that was opened in step 2.
4. Put a button on your sheet and assign the new macro to it.

This code is still written for data in columns A:AT with results to the right starting in column BA. Is that what you have?

Peter, my apologies for late response. Been ill.
No, the sheet has past draws which start in A:1, but the data (pairs to combine start in cell H, and continue to columns H:BA with results to the right starting in column BH.

Which might explain why I am getting an error when I run the macro..., I get a run time error, "type mismatch" and the debugger takes me to the following line: x = Left(a(1, j), 1)

 

[Peter_SSs]

Hmm, no error reported by you previously I don't think. You just said that the code combined the pairs before you were ready and you wanted to 'control' the code manually, so that's what I did.

Seems like the columns have all just moved to the right 7 places so try changing these lines in the previous code.

lrL = Columns("H").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
If Not IsEmpty(Range("BH1").Value) Then lrR = Columns("BH").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row


a = Range("H" & r & ":BA" & r).Value


With Range("BH" & r).Resize(, k)

Hope you have recovered fully.

 

[LuGyver]

Thank you Peter! didn't realize how long it had been since I had a chance to re-look at this post. That worked for me so I just wanted to say thank you for taking the time to help me.
Hope you have a great holiday!

 

[Peter_SSs]

Thank you Peter! didn't realize how long it had been since I had a chance to re-look at this post. That worked for me so I just wanted to say thank you for taking the time to help me.
Hope you have a great holiday!

Thanks for the follow-up. Better late than never.