copy formula across while skipping columns
 

I'm trying to write a macro that will:
1) select a range of cells within the same row - where the first cell
in the range contains a formula with a link to another cell
2)macro copies the formula from the first cell in the range and
pastes
it into the remaining cells in the selected range, while skipping a
user defined number of columns

before macro:
A B C D E F G
1 10
2
3 10 20 30 40

after macro:
A B C D E F G
1 10 20 30 40
2
3 10 20 30 40

the formula in A1 is =A3. I'd like the user to be able to 1) select
the rangeA1:G1 and 2)run
the macro so that after running C1 refers to B3, E1 refers to C3,
etc. I'd like
this to also work where the formula contains a combination of one or
more links and/or arithmetic operations. Would be awesome if this
could also work vice-a-versa.

Any ideas for how to solve this would be much appreciated!

copy formula across while skipping columns
 

Joshua,

This procedure should do what you're after (excep the vice versa). It'll ask
you to enter in the number of spacer cells, but you can hard code this or
pass it in if required.

Just select the range (single row) that you want the formulas spaced out
over, then run the procedure. It applies the same formula that's in the first
cell of the selected range.

Public Sub CopyFirstCellFormula()

Dim rngSelection As Range
Dim rngCell As Range
Dim intShiftCellAmount As Integer
Dim intCellCount As Integer
Dim intLastCell As Integer
Dim intLoop As Integer
Dim intShiftCount As Integer

Application.ScreenUpdating = False

Set rngSelection = Application.Selection
intShiftCellAmount = CInt(InputBox("Enter number of cells to skip."))

intCellCount = rngSelection.Rows(1).Cells.Count
With rngSelection.Rows(1)
'Copy formula to all cells
For Each rngCell In .Cells
.Cells(1, 1).Copy rngCell
Next

'If shift amount is 0, job done
If intShiftCellAmount 0 Then

'Get last cell to contain a formula
intLastCell = 1
Do Until intLastCell intCellCount
intLastCell = intLastCell + intShiftCellAmount + 1
intShiftCount = intShiftCount + 1
Loop
intLastCell = intLastCell - intShiftCellAmount - 1

'Shift formulas
For intLoop = intLastCell To 2 Step -(intShiftCellAmount + 1)
'Copy formula
.Cells(1, intLoop).Formula = .Cells(1, intLoop -
(intShiftCellAmount * intShiftCount) + intShiftCellAmount).Formula
'Clear cells
Range(.Cells(1, intLoop - (intShiftCellAmount *
intShiftCount) + intShiftCellAmount), .Cells(1, intLoop - 1)).ClearContents
intShiftCount = intShiftCount - 1
Next

'Clean up remainder cells
For intLoop = intLastCell + 1 To intCellCount
.Cells(1, intLoop).ClearContents
Next
End If
End With

Application.ScreenUpdating = True

End Sub


--
Please rate this post if it ansers your question.

Thanks,

Chris
www.ProfessionalExcel.com



"Joshua" wrote:

I'm trying to write a macro that will:
1) select a range of cells within the same row - where the first cell
in the range contains a formula with a link to another cell
2)macro copies the formula from the first cell in the range and
pastes
it into the remaining cells in the selected range, while skipping a
user defined number of columns

before macro:
A B C D E F G
1 10
2
3 10 20 30 40

after macro:
A B C D E F G
1 10 20 30 40
2
3 10 20 30 40

the formula in A1 is =A3. I'd like the user to be able to 1) select
the rangeA1:G1 and 2)run
the macro so that after running C1 refers to B3, E1 refers to C3,
etc. I'd like
this to also work where the formula contains a combination of one or
more links and/or arithmetic operations. Would be awesome if this
could also work vice-a-versa.

Any ideas for how to solve this would be much appreciated!

copy formula across while skipping columns
 

On Mar 13, 10:05*am, ProfessionalExcel.com
wrote:
Joshua,

This procedure should do what you're after (excep the vice versa). It'll ask
you to enter in the number of spacer cells, but you can hard code this or
pass it in if required.

Just select the range (single row) that you want the formulas spaced out
over, then run the procedure. It applies the same formula that's in the first
cell of the selected range.

Public Sub CopyFirstCellFormula()

Dim rngSelection As Range
Dim rngCell As Range
Dim intShiftCellAmount As Integer
Dim intCellCount As Integer
Dim intLastCell As Integer
Dim intLoop As Integer
Dim intShiftCount As Integer

* * Application.ScreenUpdating = False

* * Set rngSelection = Application.Selection
* * intShiftCellAmount = CInt(InputBox("Enter number of cells to skip."))

* * intCellCount = rngSelection.Rows(1).Cells.Count
* * With rngSelection.Rows(1)
* * * * 'Copy formula to all cells
* * * * For Each rngCell In .Cells
* * * * * * .Cells(1, 1).Copy rngCell
* * * * Next

* * * * 'If shift amount is 0, job done
* * * * If intShiftCellAmount 0 Then

* * * * * * 'Get last cell to contain a formula
* * * * * * intLastCell = 1
* * * * * * Do Until intLastCell intCellCount
* * * * * * * * intLastCell = intLastCell + intShiftCellAmount + 1
* * * * * * * * intShiftCount = intShiftCount + 1
* * * * * * Loop
* * * * * * intLastCell = intLastCell - intShiftCellAmount - 1

* * * * * * 'Shift formulas
* * * * * * For intLoop = intLastCell To 2 Step -(intShiftCellAmount + 1)
* * * * * * * * 'Copy formula
* * * * * * * * .Cells(1, intLoop).Formula = .Cells(1, intLoop -
(intShiftCellAmount * intShiftCount) + intShiftCellAmount).Formula
* * * * * * * * 'Clear cells
* * * * * * * * Range(.Cells(1, intLoop - (intShiftCellAmount *
intShiftCount) + intShiftCellAmount), .Cells(1, intLoop - 1)).ClearContents
* * * * * * * * intShiftCount = intShiftCount - 1
* * * * * * Next

* * * * * * 'Clean up remainder cells
* * * * * * For intLoop = intLastCell + 1 To intCellCount
* * * * * * * * .Cells(1, intLoop).ClearContents
* * * * * * Next
* * * * End If
* * End With

* * Application.ScreenUpdating = True

End Sub

--
Please rate this post if it ansers your question.

Thanks,

Chriswww.ProfessionalExcel.com

"Joshua" wrote:
I'm trying to write a macro that will:
1) select a range of cells within the same row - where the first cell
in the range contains a formula with a link to another cell
2)macro copies the formula from the first cell in the range and
pastes
it into the remaining cells in the selected range, while skipping a
user defined number of columns

before macro:
* * * * A * * * B * * * C * * * D * * * E * * * F * * * G
1 * * * 10
2
3 * * * 10 * * *20 * * *30 * * *40

after macro:
* * * * A * * * B * * * C * * * D * * * E * * * F * * * G
1 * * * 10 * * * * * * *20 * * * * * * *30 * * * * * * *40
2
3 * * * 10 * * *20 * * *30 * * *40

the formula in A1 is =A3. *I'd like the user to be able to 1) select
the rangeA1:G1 and 2)run
the macro so that after running C1 refers to B3, E1 refers to C3,
etc. *I'd like
this to also work where the formula contains a combination of one or
more links and/or arithmetic operations. *Would be awesome if this
could also work vice-a-versa.

Any ideas for how to solve this would be much appreciated!

Chris-

This is great - its exactly what I was trying to do! Thank you for
your help.

Is it rather difficult to make it do vice-verca or to do the same
thing for columns?

Thanks,

Joshua

copy formula across while skipping columns
 

Joshua,

What exactly would you want to happen in terms of 'vice-versa'?


-----
Thanks,

Chris

www.ProfessionalExcel.com



"Joshua" wrote:

On Mar 13, 10:05 am, ProfessionalExcel.com
wrote:
Joshua,

This procedure should do what you're after (excep the vice versa). It'll ask
you to enter in the number of spacer cells, but you can hard code this or
pass it in if required.

Just select the range (single row) that you want the formulas spaced out
over, then run the procedure. It applies the same formula that's in the first
cell of the selected range.

Public Sub CopyFirstCellFormula()

Dim rngSelection As Range
Dim rngCell As Range
Dim intShiftCellAmount As Integer
Dim intCellCount As Integer
Dim intLastCell As Integer
Dim intLoop As Integer
Dim intShiftCount As Integer

Application.ScreenUpdating = False

Set rngSelection = Application.Selection
intShiftCellAmount = CInt(InputBox("Enter number of cells to skip."))

intCellCount = rngSelection.Rows(1).Cells.Count
With rngSelection.Rows(1)
'Copy formula to all cells
For Each rngCell In .Cells
.Cells(1, 1).Copy rngCell
Next

'If shift amount is 0, job done
If intShiftCellAmount 0 Then

'Get last cell to contain a formula
intLastCell = 1
Do Until intLastCell intCellCount
intLastCell = intLastCell + intShiftCellAmount + 1
intShiftCount = intShiftCount + 1
Loop
intLastCell = intLastCell - intShiftCellAmount - 1

'Shift formulas
For intLoop = intLastCell To 2 Step -(intShiftCellAmount + 1)
'Copy formula
.Cells(1, intLoop).Formula = .Cells(1, intLoop -
(intShiftCellAmount * intShiftCount) + intShiftCellAmount).Formula
'Clear cells
Range(.Cells(1, intLoop - (intShiftCellAmount *
intShiftCount) + intShiftCellAmount), .Cells(1, intLoop - 1)).ClearContents
intShiftCount = intShiftCount - 1
Next

'Clean up remainder cells
For intLoop = intLastCell + 1 To intCellCount
.Cells(1, intLoop).ClearContents
Next
End If
End With

Application.ScreenUpdating = True

End Sub

--
Please rate this post if it ansers your question.

Thanks,

Chriswww.ProfessionalExcel.com

"Joshua" wrote:
I'm trying to write a macro that will:
1) select a range of cells within the same row - where the first cell
in the range contains a formula with a link to another cell
2)macro copies the formula from the first cell in the range and
pastes
it into the remaining cells in the selected range, while skipping a
user defined number of columns

before macro:
A B C D E F G
1 10
2
3 10 20 30 40

after macro:
A B C D E F G
1 10 20 30 40
2
3 10 20 30 40

the formula in A1 is =A3. I'd like the user to be able to 1) select
the rangeA1:G1 and 2)run
the macro so that after running C1 refers to B3, E1 refers to C3,
etc. I'd like
this to also work where the formula contains a combination of one or
more links and/or arithmetic operations. Would be awesome if this
could also work vice-a-versa.

Any ideas for how to solve this would be much appreciated!

Chris-

This is great - its exactly what I was trying to do! Thank you for
your help.

Is it rather difficult to make it do vice-verca or to do the same
thing for columns?

Thanks,

Joshua