Array Values filling specific cells

[AK_Beaver]

I am calculating values in a sub function and the output is being placed in an array. Is their a way to assign specific cells to those values - like when I go to print the function into an excel worksheet I want the array to print out in column C row 12 and then every other row after that like C14, C16, etc.

Thanks!

[Leith Ross]

Hello AK,

If your array is scalar (1 dimensional) then you can copy the array's contents to the worksheet like this...


Dim Data as Variant

ReDim Data(4)

Data(0) = "Line 1"
Data(1) = "Line 2"
Data(2) = "Line 3"
Data(3) = "Line 4"
Data(4)= "Line 5"

Range("C12").Resize(UBound(Data), 1).Value = Application.Transpose(Data)

[AK_Beaver]

Leith,

19093

I've attached the excel sheet I'm trying to fill from the sub function. The VBA module should be in it but I'll include my code regardless. I'm trying to create something that'll take any number of setups and work. The first row of data will always be row 11. The last row of data will vary depending on the number of setups. The Rod sums row will always be 3 rows below the last data row, the misclosure line will always be two rows below the rod sums row. I've color coded everything. dHI needs to be printed out in the yellow cells, dElev goes in the green, dCorr goes in the blue, dAdjElev in Orange, dRodSumBS in the first red cell, and dRodSumFS in the second and dMisclosure is printed out in the grey. My program runs in the sub function and calculates everything. My problem is I have no idea how to print it from the sub function into the worksheet. Can you give me any suggestions or tips?

Thanks for all your help!


Sub Looper()
Dim iSetups As Integer
Dim dStartElev As Double
Dim dMaxMisc As Double
Dim dBS() As Double
Dim dHI() As Double
Dim dFS() As Double
Dim dElev() As Double
Dim dCorr() As Double
Dim dAdjElev() As Double
Dim i As Integer
Dim Rows As Integer
Dim dRodSumBS As Double
Dim dRodSumFS As Double
Dim dMisclosure As Double


iSetups = Cells(5, 2)
dStartElev = Cells(6, 2)
dMaxMisc = Cells(7, 2)
dRodSumBS = 0
dRodSumFS = 0


ReDim dBS(iSetups)
ReDim dHI(iSetups)
ReDim dFS(iSetups)
ReDim dElev(iSetups + 1)
ReDim dCorr(iSetups + 1)
ReDim dAdjElev(iSetups + 1)


Rows = 11


For i = 1 To iSetups
dBS(i) = Cells(Rows, 2)
Rows = Rows + 2
Next i


Rows = 13


For i = 1 To iSetups
dFS(i) = Cells(Rows, 4)
Rows = Rows + 2
Next i


dElev(1) = dStartElev


For i = 1 To iSetups
dHI(i) = dElev(i) + dBS(i)
dElev(i + 1) = dHI(i) - dFS(i)
Next i


For i = 1 To iSetups
dRodSumBS = dBS(i) + dRodSumBS
dRodSumFS = dFS(i) + dRodSumFS
Next i


dMisclosure = Round(dRodSumBS - dRodSumFS, 2)


For i = 1 To iSetups + 1
dCorr(i) = Round((dMisclosure / iSetups) * (i - 1), 2)
dAdjElev(i) = dElev(i) - dCorr(i)
Next i



End Sub

[jolivanes]

To stay with Leith's example:
(Leith forgot about the extra row jump)

Sub Leith_Ross_Example()
Dim Data As Variant, i As Long, j As Long
ReDim Data(4)
j = 12
Data(0) = "Line 1"
Data(1) = "Line 2"
Data(2) = "Line 3"
Data(3) = "Line 4"
Data(4) = "Line 5"
For i = LBound(Data) To UBound(Data)
Cells(j, 3).Value = Data(i)
j = j + 2
Next i
End Sub


BTW, I have not looked at your attachment or went through your code as I only saw it when I was going to post this.
It seems to have in there what you ask for I think if I understand your question right

[AK_Beaver]

i'm trying to calculate things in the sub function and return them into the worksheet. Do I need a command button to run this? I'm confused I get the codding part to calculate everything, i"m lost on returning it to specific cells in the the worksheet

[Paul_Hossler]

Not tested

You can simplify your loops a little, and (if I understood the question) use something like the <<<<<<<<<<< line to return values to the worksheet





Sub Looper()

Dim iSetups As Long
Dim dStartElev As Double
Dim dMaxMisc As Double
Dim dBS() As Double
Dim dHI() As Double
Dim dFS() As Double
Dim dElev() As Double
Dim dCorr() As Double
Dim dAdjElev() As Double
Dim i As Integer
Dim Rows As Integer
Dim dRodSumBS As Double
Dim dRodSumFS As Double
Dim dMisclosure As Double
iSetups = Cells(5, 2)
dStartElev = Cells(6, 2)
dMaxMisc = Cells(7, 2)
dRodSumBS = 0
dRodSumFS = 0
ReDim dBS(1 To iSetups)
ReDim dHI(1 To iSetups)
ReDim dFS(1 To iSetups)
ReDim dElev(1 To iSetups + 1)
ReDim dCorr(1 To iSetups + 1)
ReDim dAdjElev(1 To iSetups + 1)

For i = LBound(dBS) To UBound(dBS)
dBS(i) = 11 + Cells(2 * (i - 1), 2)
Next I

For i = LBound(dFS) To UBound(dFS)
dFS(i) = 13 + Cells(2 * (i - 1), 2)
Next I

dElev(1) = dStartElev
For i = LBound(dHI) To UBound(dHI)
dHI(i) = dElev(i) + dBS(i)
dElev(i + 1) = dHI(i) - dFS(i)
Next I

For i = LBound(dBS) To UBound(dBS)
dRodSumBS = dBS(i) + dRodSumBS
dRodSumFS = dFS(i) + dRodSumFS
Next I

dMisclosure = Round(dRodSumBS - dRodSumFS, 2)
For i = LBound(dCorr) To UBound(dCorr)
dCorr(i) = Round((dMisclosure / iSetups) * (i - 1), 2)
dAdjElev(i) = dElev(i) - dCorr(i)
Next I

Cells(28, 2).Value = dRodSumBS ' <<<<<<<<<<<<<<<<<<

End Sub

[AK_Beaver]

Thanks for all the help guys. All your suggestions did the trick. Appreciate it.