double a 5 by 5 cell table
 

I need a macro to take a 5 row by 5 column array with numbers in each
cell and split it into a 9 by 9 array with new blank cells.

double a 5 by 5 cell table
 

This is a general purpose macro that will work with any size table any wher
in the workbook

Set MyRange = Range("D5:H9")
NumRows = MyRange.Rows.Count
NumCols = MyRange.Columns.Count

LastRow = MyRange.Row + NumRows - 1
For RowCount = LastRow To (MyRange.Row + 1) Step -1
Set InsertRange = Range(Cells(RowCount, MyRange.Column), _
Cells(RowCount, MyRange.Column + NumCols - 1))
InsertRange.Insert shift:=xlDown
Next RowCount
LastRow = MyRange.Row + (2 * (NumRows - 1))
LastCol = MyRange.Column + NumCols - 1
For ColCount = LastCol To (MyRange.Column + 1) Step -1
Set InsertRange = Range(Cells(MyRange.Row, ColCount), _
Cells(LastRow, ColCount))
InsertRange.Insert shift:=xlToRight
Next ColCount


"Fan924" wrote:

I need a macro to take a 5 row by 5 column array with numbers in each
cell and split it into a 9 by 9 array with new blank cells.

double a 5 by 5 cell table
 

Thanks Joel. :}
I temporarily modified the code to add blank columns only. After it
runs, I would like to fill all blank cells with a formula "=RC[-1]/
2+RC[1]/2". The idea is to double the size of a table then filling the
new cells with the average value of the cells to the left and right.

Sub double()
Dim MyRange As Range
Set MyRange = Selection
NumRows = MyRange.Rows.Count
NumCols = MyRange.Columns.Count
LastRow = MyRange.Row + (2 * (NumRows - 1))
LastCol = MyRange.Column + NumCols - 1
For ColCount = LastCol To (MyRange.Column + 1) Step -1
Set InsertRange = Range(Cells(MyRange.Row, ColCount), Cells
(LastRow, ColCount))
InsertRange.Insert shift:=xlToRight
Next ColCount
End Sub

double a 5 by 5 cell table
 

I fixed the code to add rows and columns. I not sure what you need. I not
sure if you really have a 5x5 table or a 5x6 Table. the difference is the
formula right of the 1st column. Does the 1st column need a different
formula than the other columns?

Sub doubleCol()
Dim MyRange As Range
Set MyRange = Selection
NumRows = MyRange.Rows.Count
NumCols = MyRange.Columns.Count
LastRow = MyRange.Row + NumRows - 1
LastCol = MyRange.Column + NumCols - 1
For ColCount = LastCol To MyRange.Column Step -1
Set FormulaRange = Range(Cells(MyRange.Row, ColCount + 1), _
Cells(LastRow, ColCount + 1))
FormulaRange.FormulaR1C1 = "=RC[-2]/2+RC[-1]/2"
If ColCount < MyRange.Column Then
Set InsertRange = Range(Cells(MyRange.Row, ColCount), _
Cells(LastRow, ColCount))
InsertRange.Insert shift:=xlToRight
End If
Next ColCount

LastRow = MyRange.Row + NumRows
'add 1 at end for formula
LastCol = MyRange.Column + (2 * (NumCols - 1)) + 1
For RowCount = LastRow To (MyRange.Row + 1) Step -1
Set InsertRange = Range(Cells(RowCount, MyRange.Column), _
Cells(RowCount, LastCol))
InsertRange.Insert shift:=xlDown
Next RowCount

End Sub


"Fan924" wrote:

Thanks Joel. :}
I temporarily modified the code to add blank columns only. After it
runs, I would like to fill all blank cells with a formula "=RC[-1]/
2+RC[1]/2". The idea is to double the size of a table then filling the
new cells with the average value of the cells to the left and right.

Sub double()
Dim MyRange As Range
Set MyRange = Selection
NumRows = MyRange.Rows.Count
NumCols = MyRange.Columns.Count
LastRow = MyRange.Row + (2 * (NumRows - 1))
LastCol = MyRange.Column + NumCols - 1
For ColCount = LastCol To (MyRange.Column + 1) Step -1
Set InsertRange = Range(Cells(MyRange.Row, ColCount), Cells
(LastRow, ColCount))
InsertRange.Insert shift:=xlToRight
Next ColCount
End Sub

double a 5 by 5 cell table
 

Nice. I cut it down to columns only. This works nicely.

Sub double_2Col()
Dim MyRange As Range
Set MyRange = Selection
NumRows = MyRange.Rows.Count
NumCols = MyRange.Columns.Count
LastRow = MyRange.Row + NumRows - 1
LastCol = MyRange.Column + NumCols - 1
For ColCount = LastCol To MyRange.Column Step -1
Set FormulaRange = Range(Cells(MyRange.Row, ColCount + 1), Cells
(LastRow, ColCount + 1))
FormulaRange.FormulaR1C1 = "=RC[-1]/2+RC[+1]/2"
If ColCount < MyRange.Column Then
Set InsertRange = Range(Cells(MyRange.Row, ColCount), Cells
(LastRow, ColCount))
InsertRange.Insert shift:=xlToRight
End If
Next ColCount
End Sub
__________________________________________________ _________________

I tried to modify it to do rows with a formula. I get something
looking like a Chinese puzzle. Where an I going wrong?

Sub double__Row()
Dim MyRange As Range
Set MyRange = Selection
NumRows = MyRange.Rows.Count
NumCols = MyRange.Columns.Count
LastRow = MyRange.Row + NumRows
LastCol = MyRange.Column + NumCols - 1
For RowCount = LastRow To (MyRange.Row + 1) Step -1
Set FormulaRange = Range(Cells(MyRange.Column, RowCount + 1), Cells
(LastCol, RowCount + 1))
FormulaRange.FormulaR1C1 = "=R[-1]C/2+R[1]C/2"
If RowCount < MyRange.Row Then
Set InsertRange = Range(Cells(RowCount, MyRange.Column), Cells
(RowCount, LastCol))
InsertRange.Insert shift:=xlDown
End If
Next RowCount
End Sub

double a 5 by 5 cell table
 

Got it working. Thanks Joel. I learned a lot. I do it in 2 steps.
First columns then rows.