Fill an array LIKE a multiplication table with a macro

[tjakatjs]

Fair warning: This seems like a long winded explanation for a fairly simple macro.

I want to use a macro to complete an array that LOOKS LIKE a multiplication table but is not. Obviously, to complete a table like the one in the example would be simple enough to do with a formula copied to each cell but the worksheet I have uploaded is a gross oversimplification of the real thing. In the actual worksheet, the "product" in AE23 is a multilevel if/then, lookup statement that precludes simply filling the array with formulas. The process for filling it will be the same as in this simplified example using the ranges given in the example.

The x and y values may not always be the integers they are now but they would always have the same interval so I'm thinking it would be easier, rather than accessing the column/row in Sheet 2 each time to simply declare the value as an integer and add the given interval, in this case 1 and -1, to it in two separate loops, one to complete the first column and then move to the next column and complete it when there are no more values on the y axis. For example:

set x = Sheet 2:B1
set y = Sheet 2:A2

Loop one:
 Sheet 1:B22 = x 

Loop 2:


Do until column Sheet 2!A is blank:
Sheet1!B21 = y
Copy value of Sheet 1:B23 to appropriate cell in Sheet 2 (needs to move down one row with each loop 2 and over one for each loop 1)
Add 1 to y

end loop 2

Do until Sheet 2!Row 1 is empty
Add -1 to x





Using Record Macro to cycle through the second loop three times looks like this. 

 Sheet2!Range("B22").Select
    ActiveCell.FormulaR1C1 = "=Sheet2!R[-21]C"
    Range("B21").Select
    ActiveCell.FormulaR1C1 = "=Sheet2!R[-19]C[-1]"
    Range("B23").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
    Range("B21").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "2"
    Range("B23").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
    Range("B21").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "3"
    Range("B23").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

[p45cal]

In your file run this macro:

Sub blah()
Set CellsToFill = Sheets("Sheet2").Range("A1").CurrentRegion
Set CellsToFill = Intersect(CellsToFill, CellsToFill.Offset(1, 1))
'Application.Goto CellsToFill 'just to confirm you've got the right cells to be filled.
With Sheets("Sheet1")
  For Each cll In CellsToFill.Cells
    .Range("B22").Value = cll.Parent.Cells(1, cll.Column)
    .Range("B21").Value = cll.Parent.Cells(cll.Row, 1)
    cll.Value = .Range("B23").Value
  Next cll
End With
End Sub

What actually is the formula in cell AE23? There could be a simpler solution.

[snb]

Why so complicated ?

Sub M_snb()
   sn = [index(MMUlt(row(1:50),-transpose(row(1:54))),)]
End Sub

[p45cal]

Why so complicated ?

because:

• 'In the actual worksheet, the "product" in AE23 is a multilevel if/then, lookup statement'
• 'The x and y values may not always be the integers they are now'
• 'Do until column Sheet 2!A is blank'
• 'Do until Sheet 2!Row 1 is empty'

[tjakatjs]

AE23 is actually on a separate sheet and is a vlookup =VLOOKUP(AD20,AL38:AM10485,2,FALSE) which, yeah, is dependent on those two variables in a multilevel if, and else statement.

THIS WORKS. It takes awhile but really only has to be run once so it is good. Once the results are stored as values it shouldn't bog the thing down too much.

THANK YOU THANK YOU THANK YOU. I had pulled my old book out but I would have never gotten there this way. Obviously, I'm sure.

In your file run this macro:

Sub blah()
Set CellsToFill = Sheets("Sheet2").Range("A1").CurrentRegion
Set CellsToFill = Intersect(CellsToFill, CellsToFill.Offset(1, 1))
'Application.Goto CellsToFill 'just to confirm you've got the right cells to be filled.
With Sheets("Sheet1")
  For Each cll In CellsToFill.Cells
    .Range("B22").Value = cll.Parent.Cells(1, cll.Column)
    .Range("B21").Value = cll.Parent.Cells(cll.Row, 1)
    cll.Value = .Range("B23").Value
  Next cll
End With
End Sub

What actually is the formula in cell AE23? There could be a simpler solution.