Creating a table with formulas...

R

Redrazorneck1

New Member
Joined
Aug 10, 2005
Messages
6
I need to set up a table that uses one column of data (column A). The data consists of location codes, and the table headers will be "ship-from" and "ship-to". My task is to get the one column of data into the table so that each possible scenario is captured. If I have 50 locations, I'll have 50x49 (you can't ship to yourself) possibilities, or 2,450 combinations :eek: . Here's a small example of what I'm trying to do:

Column A
1
2
3


Ship From / Ship To
1 / 2
1 / 3
2 / 1
2 / 3
3 / 1
3 / 2

Is there a quick way to get this done? Thanks!
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
assuming that your data is in column A (starting in A2-ie header in A1) and your ship from is in column B and your ship to is in column C

try this

Code: 
Sub TableComb()
Dim myArrayCol As Variant, i As Integer, lastrowB, lastrowA
lastrowA = Range("A65536").End(xlUp).Row
myArrayCol = Application.Transpose(Range("A2:A" & LastRowA))
For i = LBound(myArrayCol) To UBound(myArrayCol)
    For j = LBound(myArrayCol) To UBound(myArrayCol)
      If myArrayCol(j) <> myArrayCol(i) Then
        lastrowB = Range("B65536").End(xlUp).Row + 1
        Cells(lastrowB, "B").Value = myArrayCol(i)
        Cells(lastrowB, "B").Offset(0, 1).Value = myArrayCol(j)
      End If
    Next j
Next i
End Sub


To use this:

ALT-F11 (brings you to VB Editor)
Select INSERT, MODULE (and paste in the code starting from Sub..to End Sub

Then Exit from VBE
In Excel hit TOOLS, MACROS, MACRO and select the TableComb macro to run
 
Upvote 0
That works, NoocH, but I'm hitting a different problem. I have a total of 371 locations, and I'm hitting up against the total row limitation (>65,536 rows). Any chance the macro can spill over to a new worksheet once it hits row 65,536 for the remainder of the data?
 
Upvote 0
Redrazorneck1 said:
That works, NoocH, but I'm hitting a different problem. I have a total of 371 locations, and I'm hitting up against the total row limitation (>65,536 rows). Any chance the macro can spill over to a new worksheet once it hits row 65,536 for the remainder of the data?
Click to expand...

yup it would compute to 68635...

i won't have a chance to look into it till tomorrow...

do you just want it in cell E, F in same book?
 
Upvote 0
NoocH, that would work - just put them in the same worksheet (columns E and F are fine) and I'll copy/paste values in another spot for my SAP config load. Cheers, and THANKS! (y)
 
Upvote 0
Redrazorneck1 said:
NoocH, that would work - just put them in the same worksheet (columns E and F are fine) and I'll copy/paste values in another spot for my SAP config load. Cheers, and THANKS! (y)
Click to expand...

actually now that i looked at it there are 371*370=137,270 rows needed....
i set it up to go to B/C, E/F, H/I (down to row 65000 on the first two sections)....that should give you enough to do around 440 without any changes...
PS...what happened to the 50 from the original post...haha...


NOTE: it does take a few minutes to run through all the combinations... (may actually appear that it's frozen...but it's not...just be patient)
is this a one time thing or do you plan or running multiple times?

hope this helps...




Code: 
Sub TableComb()
Dim myArrayCol As Variant, i As Integer, lastrowB, lastrowA, lastrowE, lastrowH
Application.ScreenUpdating = False
lastrowA = Range("A65536").End(xlUp).Row
myArrayCol = Application.Transpose(Range("A2:A" & lastrowA))
For i = LBound(myArrayCol) To UBound(myArrayCol)
    For j = LBound(myArrayCol) To UBound(myArrayCol)
      If myArrayCol(j) <> myArrayCol(i) Then
        lastrowB = Range("B65536").End(xlUp).Row + 1
        lastrowE = Range("E65536").End(xlUp).Row + 1
        lastrowH = Range("H65536").End(xlUp).Row + 1
        If lastrowB <= 65000 Then
          Cells(lastrowB, "B").Value = myArrayCol(i)
          Cells(lastrowB, "B").Offset(0, 1).Value = myArrayCol(j)
        ElseIf lastrowE <= 65000 Then
          Cells(lastrowE, "E").Value = myArrayCol(i)
          Cells(lastrowE, "E").Offset(0, 1).Value = myArrayCol(j)
        ElseIf lastrowH <= 65000 Then
          Cells(lastrowH, "H").Value = myArrayCol(i)
          Cells(lastrowH, "H").Offset(0, 1).Value = myArrayCol(j)
        Else
          Msgbox "Too many combinations...Please change code to handle"
        End If
      End If
    Next j
Next i
Application.ScreenUpdating = True
End Sub
 
Upvote 0
RE: the 50 count example above - I wasn't thinking at the time I was typing the post (which is normal for me) :oops:

Also, this is a one time thing. I work for a company that is implementing SAP, and this data is required for a table that needs to be uploaded. I sure as he|| don't want to type in 137,000 rows in that thing. :eek:

Thanks for your effort - I shall bow in your presence from here on out...

RRN
 
Upvote 0
Redrazorneck1 said:
RE: the 50 count example above - I wasn't thinking at the time I was typing the post (which is normal for me) :oops:

Also, this is a one time thing. I work for a company that is implementing SAP, and this data is required for a table that needs to be uploaded. I sure as he|| don't want to type in 137,000 rows in that thing. :eek:

Thanks for your effort - I shall bow in your presence from here on out...

RRN
Click to expand...

ok...i just wanted to make sure you didn't want it run multiple times b/c i would need to find a way to speed it up...

did you run it and did it work as intended?
 
Upvote 0
Hi TheNoocH,
reg PM
following code took about 14 sec on my old machine

Code: 
Sub test()
Dim a, i As Long, ii As Long, iii As Long, result()
Dim x, y, stime As Double
stime = Timer
a = Application.Transpose(Range("a1", Range("a65536").End(xlUp)).Value)
x = UBound(a) * (UBound(a) - 1)
y = Application.RoundUp(x / 65534, 0)
If y > 1 Then
    ReDim result(1 To 65534, 1 To y * 2)
Else
    ReDim result(1 To x, 1 To 2)
End If
For i = LBound(a) To UBound(a)
    For ii = LBound(a) To UBound(a)
        If a(i) <> a(ii) Then
            iii = iii + 1: x = (Application.RoundDown(iii / 65535, 0) + 1) * 2
            y = iii Mod 65535
            If y = 0 Then y = 1
            result(y, x - 1) = a(i): result(y, x) = a(ii)
        End If
    Next
Next
With Range("e2")
    .CurrentRegion.ClearContents
    .Resize(UBound(result, 1), UBound(result, 2)).Value = result
End With
MsgBox Format(Timer - stime, "#,###.000" & " seconds")
End Sub
 
Upvote 0
It ran for about 5 minutes - and it worked beautifully. The total rows created matched up perfectly with the calculated amount (371 x 370).

CHEERS! (y)

RRN
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Create Excel Packing Slips using CSV Data
Replies
4
Views
293
StaceyVECL
S
Y
  • Solved
VBA: Using SUMIF on column H when value in column A is unique
2
Replies
17
Views
460
Yamezz
Y
F
  • Solved
How to format a vendor list when vendors offer several different products?
Replies
8
Views
207
Micron
M
T
  • Question
Count Unique Values
Replies
1
Views
439
awoohaw
awoohaw
S
  • Solved
Copy formula down a table column, but skip used cells in that column
Replies
4
Views
316
sspatriots
S

Forum statistics

Threads
1,215,372
Messages
6,124,542
Members
449,169
Latest member
mm424

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top