String Cell Formula from Column Headings

[MachaMacha]

Hello All,

I have attached an image of what I am trying to do. In cell O11 there is a formula =B17+C10+...+M20+N11. I am trying to make a macro that each time I run the macro on an active cell, the formula is displayed in a new worksheet called "Formulas". I would like the formula to be displayed according to the column headings instead of the Column Labels (A-IV).

For Example
I run the macro on cell O11
A new worksheet in the same workbook called "Formulas" is created
In cell A1 of "Formulas" I get the location of the cell that the
macro was run on (Sheet1!O11)
In Cell B1 I get a string of the formula,
'AL17+AK10+...+ME11

Each time I run the macro, the cell location and formula should be added to the next cell offset by 1 row in the Formulas worksheet. Also sometimes the precedent cells may be from many different cells from different worksheets within the same workbook, not just from one worksheet like in this example. In that case I would like the Worksheet name to precede the cell reference. Assume that all row2's of every sheet has a column name/label/heading.

Thanks.

[figment]

first off thanks for making my lunch interesting

and i hope this works for you

[vba]Sub testing()
Dim a As Long, work As Worksheet, er As Boolean, ra As Range, awork As Worksheet
Set ra = ActiveCell
Set awork = ActiveSheet
er = True
For Each work In ActiveWorkbook.Worksheets
If work.Name = "Formulas" Then er = False
Next
If er Then
Set work = ActiveWorkbook.Worksheets.Add
work.Name = "Formulas"
Else
Set work = Worksheets("Formulas")
End If
a = 1
While work.Range("A" & a) <> ""
a = a + 1
Wend
awork.Select
work.Range("B" & a) = "'" & headerformula(ra.Formula)
If work.Range("B" & a) <> "" Then work.Range("A" & a) = ra.Address
End Sub

Function headerformula(form As String)
Dim a As Long
If Len(form) > 0 Then
If Left(form, 1) = "+" Or Left(form, 1) = "-" Or Left(form, 1) = "*" Or Left(form, 1) = "/" Or Left(form, 1) = "=" Then
headerformula = Left(form, 1) & headerformula(Right(form, Len(form) - 1))
Exit Function
End If
For a = 1 To Len(form)
If Mid(form, a, 1) = "+" Or Mid(form, a, 1) = "-" Or Mid(form, a, 1) = "*" Or Mid(form, a, 1) = "/" Or Mid(form, a, 1) = "=" Then
headerformula = findheader(Left(form, a - 1)) & headerformula(Right(form, Len(form) - (a - 1)))
Exit Function
End If
Next
headerformula = findheader(form)
End If
End Function


Function findheader(a As String)
Dim b As Long, c As Long
b = Range(a).Row
For c = 1 To b - 1
If Range(a).Offset(-c, 0) = "" Then
findheader = Range(a).Offset(-c + 1, 0) & b
Exit Function
End If
Next
findheader = Range(a).Offset(-b + 1, 0) & b
End Function
[/vba]

this code relys on the header row having a space above it, or bing in row 1. if there is something in the cell above you header, then the code will use that as the column name rather then the table header