Opening and Writing Multiple Sheets In Excel Using VBA6

[Qpido]

Dear Helpful Members of Mr Excel,

I have been working on several projects to automate work in the company I am working for and have come to the following problem:

I have a VBA6 program I have successfully programmed to calculate the costs of our fasteners and anchors, now it is important that I get the data placed in an excel file.

Some data for you before going on:
Interface picture general layout:
http://img14.imageshack.us/i/interfacecq.jpg/

Private Sub Form_Load()

lstAnchorType.AddItem ("FFS")

Call AlloyLoad

End Sub
Private Sub cmdCalc_Click()

If lstAnchorType = "FFS" Then
Call FFSCalc
End If

End Sub
Sub AlloyLoad()

lstAlloy.Clear

CS37 = "Carbon Steel / ST37"
S304 = "AISI 304 / DIN 1.4301"
S308 = "AISI 308 / DIN 1.4303"
S309 = "AISI 309 / DIN 1.4828"
MA253 = "253MA / DIN 1.4835"
S310 = "AISI 310s / DIN 1.4845"
S314 = "AISI 314 / DIN 1.4841"
S316 = "AISI 316 / DIN 1.4401,1.4404"
S321 = "AISI 321 / DIN 1.4541"
S330 = "AISI 330 / DIN 1.4864"
I601 = "Inconel 601 / DIN 2.4851"
I625 = "Inconel 625 / DIN 2.4856"
I800H = "Inconel 800H / 1.4876"

lstAlloy.AddItem CS37
lstAlloy.AddItem S304
lstAlloy.AddItem S308
lstAlloy.AddItem S309
lstAlloy.AddItem MA253
lstAlloy.AddItem S310
lstAlloy.AddItem S314
lstAlloy.AddItem S316
lstAlloy.AddItem S321
lstAlloy.AddItem S330
lstAlloy.AddItem I601
lstAlloy.AddItem I625
lstAlloy.AddItem I800H



End Sub

Private Sub lstAlloy_Click()

Call DensityCalc

End Sub

Private Sub lstAnchorType_Click()

If lstAnchorType = "FFS" Then
picAnchor.Picture = LoadPicture("F:\Silicon logo files\siliconlogo.jpg")
Call FFSset
End If

End Sub

Sub FFSset()

Dim dia As Double
Dim amount As Integer


dia = 5.25
amount = 1
txtDiameter.Text = dia
txtAmount.Text = amount


txtDiameter.BackColor = &HE0E0E0
txtDiameter.Locked = True
txtHeight.BackColor = &HE0E0E0
txtHeight.Locked = True
txtWidth.BackColor = &HE0E0E0
txtWidth.Locked = True



End Sub

Sub DensityCalc()

CS37 = "Carbon Steel / ST37"
S304 = "AISI 304 / DIN 1.4301"
S308 = "AISI 308 / DIN 1.4303"
S309 = "AISI 309 / DIN 1.4828"
MA253 = "253MA / DIN 1.4835"
S310 = "AISI 310s / DIN 1.4845"
S314 = "AISI 314 / DIN 1.4841"
S316 = "AISI 316 / DIN 1.4401,1.4404"
S321 = "AISI 321 / DIN 1.4541"
S330 = "AISI 330 / DIN 1.4864"
I601 = "Inconel 601 / DIN 2.4851"
I625 = "Inconel 625 / DIN 2.4856"
I800H = "Inconel 800H / 1.4876"

If lstAlloy = CS37 Then
txtDensity = 0.0078
Me.txtAlloyPrice.Text = FOTRICWB("f:\Price Calculation\Prices.RawMaterial.xls", "RMP", "c6")
End If
If lstAlloy = S304 Then
txtDensity = 0.0078
End If
If lstAlloy = S308 Then
txtDensity = 0.0079
End If
If lstAlloy = S309 Then
txtDensity = 0.0079
End If
If lstAlloy = MA253 Then
txtDensity = 0.0078
End If
If lstAlloy = S310 Then
txtDensity = 0.0079
End If
If lstAlloy = S314 Then
txtDensity = 0.0079
End If
If lstAlloy = S316 Then
txtDensity = 0.0079
End If
If lstAlloy = S321 Then
txtDensity = 0.0078
End If
If lstAlloy = S330 Then
txtDensity = 0.0081
End If
If lstAlloy = I601 Then
txtDensity = 0.00825
End If
If lstAlloy = I625 Then
txtDensity = 0.00862
End If
If lstAlloy = I800H Then
txtDensity = 0.0081
End If
lblKgCm3.Caption = "Kg/cm3"

End Sub


Private Sub txtLength_Change()

Dim lengte As Double
Dim brutolengte As Double

lengte = Val(txtLength)
brutolengte = lengte + 3

txtBLength = brutolengte

End Sub

Sub FFSCalc()

If txtDensity.Text = "" Then
MsgBox ("Select an Alloy.")
End If
If txtLength.Text = "" Then
MsgBox ("Set a length.")
End If

'Raw Material Definitions
Dim d As Double
Dim l As Double
Dim amount As Double
Dim dens As Double
Dim gewicht As Double
Dim volume As Double
Dim price As Double
Dim basecost As Double
'Labor Cost Definitions
Dim instel As Double
Dim admin As Double
Dim afkorten As Double '1800/h
Dim punten As Double '1250/h
Dim stampen As Double '1000/h
Dim ontvetten As Double '1200/h
Dim inpak As Double '5000/h
Dim uurloon As Integer  '65euro/h
'Dim amount As Double already done
Dim werkkost As Double
'Raw Material Calculations

Const PI = 3.14159265358979

d = Val(txtDiameter)
l = Val(txtBLength)
amount = Val(txtAmount)
dens = Val(txtDensity)
price = Val(txtAlloyPrice)
'Labor Related
uurloon = 65
instel = 1.5
admin = 1
afkorten = amount / 1800
punten = amount / 1250
stampen = amount / 1000
ontvetten = amount / 1200
inpak = amount / 5000

volume = (l / 10) * PI * (((d / 10) / 2) ^ 2)

gewicht = dens * volume

basecost = gewicht * amount * price

txtBaseCostMaterial.Text = (Format(CSng(basecost), "#.####"))

werkkost = (instel + admin + afkorten + punten + stampen + ontvetten + inpak) * uurloon

txtLaborCost = (Format(CSng(werkkost), "#.####"))



End Sub


Function FOTRICWB(ClosedWorkbookFullName As String, _
    SheetName As String, RangeAddress As String) As Variant
    
    Dim conn As Object, rs As Object, SQL As String
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & ClosedWorkbookFullName & _
    ";Extended Properties=""Excel 8.0;HDR=NO;"""
    
    SQL = "Select * From [" & SheetName & "$" & RangeAddress & ":" & RangeAddress & "]"
    rs.Open SQL, conn, 1, 3
    FOTRICWB = rs.Fields(0).Value
    rs.Close: conn.Close
    
    If IsNull(FOTRICWB) Then FOTRICWB = ""

End Function

The deal is this:
When I press the button I want to have Excel open and data to be there automatically.

I will take the data from the calculations and paste these like in this picture:
http://img16.imageshack.us/f/excellayout.png/

On the left I would like to have the ability to indicate a minimum and maximum value and decide the increment according to it.

There will have to be 10 different worksheets, one for each amount.

Let me know some ideas you guys have that could help me out.

Thanks as always,

Jerome