Excel VBA prompt for cells, then use in relative formula

[kitty111222]

Hi,
I am looking for a way to prompt for cell addresses, and then use these in a formula, that I can copy into other cells.
This is an example of my text: - the position of the digits are always the same -

one cell contains a text like: XXXXXXXXX _.30 356.0X 591.5 J 1/3000 - (size is in mms (356*591.5), 3000 sheets per box), another cell the number of boxes: e.g 26, and then I would like to prompt for the result in m2

'

'=(((MID(C4,16,6))*(MID(C4,23,6))*(RIGHT(C4,4))*H4)/1000000) - now the text is in cell C4 and the nr. of boxes in H4. But it's variable in what column the texts are and in what column the quantities.

So, I want to ask 3 questions: in what cell is the text, in what cell is the quantity in boxes, and where do you want the result in m2. The result should be the formula, that I can copy down for the entire column. Hope the question is clear, can someone please help? I have this - but is gives absolute results and not the formula. On Error GoTo Cancelled Dim answer As Variant answer = Application.InputBox("Select cell with the material description", "M2 calculation", vbOKCancel) If answer = vbCancel Then GoTo Cancelled End If Dim answer2 As Variant answer2 = Application.InputBox("Select cell with the Qty in BOX", "M2 calculation", vbOKCancel) If answer2 = vbCancel Then GoTo Cancelled End If Dim answer3 As Variant answer3 = Application.InputBox("Select cell where you want the m2 amount", "M2 calculation", vbOKCancel) If answer3 = vbCancel Then GoTo Cancelled End If ActiveCell.Select ActiveCell.FormulaR1C1 = Mid(answer, 14, 6) 'ActiveCell.Formula = "=(((Mid(answer, 14, 6)) * (Mid(answer, 21, 6)) * (Right(answer, 3)) * answer2 / 1000000))" 'ActiveCell.Offset(1, 0).Range("A1").Select ActiveCell.Select Cancelled: End Sub

 

[Engberg]

Try this

Sub mySub()

On Error Resume Next
Dim answer As Range

Set answer = Application.InputBox( _
Title:="M2 calculation", _
Prompt:="Select cell with the material description", _
Type:=8)
If answer Is Nothing Then Exit Sub
Set answer = Rng.Cells(1, 1)


Dim answer2 As Range
Set answer2 = Application.InputBox( _
Title:="M2 calculation", _
Prompt:="Select cell with the Qty in BOX", _
Type:=8)
If answer2 Is Nothing Then Exit Sub
Set answer2 = Rng.Cells(1, 1)

Dim answer3 As Range
Set answer3 = Application.InputBox( _
Title:="M2 calculation", _
Prompt:="Select cell where you want the m2 amount", _
Type:=8)
If answer3 Is Nothing Then Exit Sub
Set answer3 = Rng.Cells(1, 1)

On Error GoTo Cancelled

[answer3].Formula = "=(((Mid(" & answer.Address(0, 0) & ",14,6))*(Mid(" & answer.Address(0, 0) & ",21,6))*(Right(" & answer.Address(0, 0) & ",3))*" & answer2.Address(0, 0) & "/1000000))"

Cancelled:

End Sub

 

[kitty111222]

Beautiful! Thank you so much!