Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 542
Default Input boxes

I do not use these input boxes a lot, so I need a little hand with the code.
I have this code that opens an excel workbook so that it can import data into
my template workbook. However, now I have a couple of other people doing
this procedure and I would like to have an Input Message box that prompts the
user to enter their initials.

The place where my initial go are at this line " 'E3 Entered By" I would
like to have an input box here that allows the user to enter their own inital.

Below is my code:

Option Explicit

Sub ISOTECH_ImportData()
On Error GoTo err_ImportData
'************************************************* ******************************
'This procedure imports data from a selected file with GWIS layout
' into a template file.
'When running macro you will be asked to select job file to get data from. It
'is IMPORTANT that the data come with the following columns if a column is not
'there add the column, no data will be entered in the template.

'A = Company Lab# B = Isotech Lab# C = Isotech Job# D = SampleDate
'E = SampleTime F = Depth G = GasUnits H = GCDate
'I = O2 + Ar J = CO2 K = N2 L = CO
'M = C1 N = C2 O = C2H4 P = C3
'Q = C3H6 R = iC4 S = nC4 T = iC5
'U = nC5 V = C6+ W = MassSpec Date X = d13C1
'Y = d13C2 Z = d13C3 AA = d13iC4 AB = d13nC4
'AC = dDC1 AD = Comments

'************************************************* ******************************
Const lngLast As Long = 65536
Dim lngLastRow As Long
Dim i As Long
Dim r As Long
Dim j As Integer
Dim strDataFileName As String
Dim strInitFileName As String
Dim strInitShtName As String
Dim intStartRow As Integer
Dim strLookupShtName As String
Dim bFlag As Boolean
Dim k As Integer
Dim m As Integer
Dim intFirstInputRow As Integer
Dim intLastInputCol As Integer
Application.ScreenUpdating = False

strInitFileName = ActiveWorkbook.Name
strInitShtName = ActiveSheet.Name
intStartRow = 15 'beginning row on lookup sheet
intFirstInputRow = 3 'first row on template sheet
intLastInputCol = 39 'last column we're importing on template sheet,
currently AM (39)
r = intFirstInputRow
k = 1
m = 1

lngLastRow = Cells(lngLast, 1).End(xlUp).Row
If lngLastRow intFirstInputRow - 1 Then
Range(Cells(intFirstInputRow, 1).Address & ":" & Cells(lngLastRow,
intLastInputCol).Address).Clear
End If

'obtain and open data file
strDataFileName = Application.GetOpenFilename("Microsoft Excel (*.xls),
*.xls")
bFlag = True
If strDataFileName = False Then
If k < 2 Then
MsgBox "No file was selected. This procedure will now be
terminated."
GoTo exit_ImportData
End If
End If
If strDataFileName = "" Or Len(strDataFileName) = 0 Then
MsgBox "No file was selected. This procedure will now be
terminated."
GoTo exit_ImportData
End If
bFlag = False

'check to see if file already open
For i = 1 To Workbooks.Count
If Workbooks(i).FullName = strDataFileName Then
Workbooks(i).Activate
strDataFileName = Workbooks(i).Name
m = 2
Exit For
End If
Next i

'don't reopen
If m = 1 Then
Workbooks.Open Filename:=strDataFileName
strDataFileName = ActiveWorkbook.Name
End If

ActiveWorkbook.Sheets(1).Activate
strLookupShtName = ActiveSheet.Name
lngLastRow = Cells(lngLast, 1).End(xlUp).Row

'cycle thru rows and input data
For i = intStartRow To lngLastRow
If Len(Cells(i, 2).Value) 0 Then


'GWIS TEMPLATE -- DATA SOURCE

'A3 Sample ID -- A15 Company Lab #/SampleID/GWIS SampleID
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
1).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
1).Value
'B3 Prep
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
2).Value = "NOPR"
'C3 Reqnum
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
3).Value = "NA"
'D3 Vendor
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
4).Value = "ISOTECH"
'E3 Entered By
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
5).Value = "JRV"
'F3 Time Stamp
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
6).Value = Now()
'G3 Units
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
7).Value = "PPM"
'H3 Vendor Sample No -- B15 IsoTech Lab No.
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
8).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
2).Value
'I3 Vendor Project Num -- C15 IsoTech Lab No.
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
9).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
3).Value

'J3 InjDate -- D15 & E15 Sample Date and Sample Time
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r, 10).Value
= _

DateSerial(Year(Workbooks(strDataFileName).Sheets( strLookupShtName).Cells(i,
4).Value), _
Month(Workbooks(strDataFileName).Sheets(strLookupS htName).Cells(i,
4).Value), _
Day(Workbooks(strDataFileName).Sheets(strLookupSht Name).Cells(i,
4).Value)) + _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i, 5).Value

'K3 Amount Gas Units -- G15 Gas Units
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
11).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
7).Value
'L3 Proc Date -- H15 GC Date
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
12).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
8).Value
'M3 AR_O2 -- I15 O2+Ar
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
13).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
9).Value
'N3 CO2 -- J15 CO2
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
14).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
10).Value
'O3 N2 -- K15 N2
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
15).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
11).Value
'P3 CO -- L15 CO
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
16).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
12).Value
'Q3 NC1 -- M15 C1
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
17).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
13).Value
'R3 NC2 -- N15 C2
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
18).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
14).Value
'S3 Ethylene -- O15 C2H4
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
19).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
15).Value
'T3 NC3 -- P15 C3
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
20).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
16).Value
'U3 Propylene -- Q15 C3H6
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
21).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
17).Value
'V3 iC4 -- R15 iC4
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
22).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
18).Value
'W3 NC4 -- S15 nC4
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
23).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
19).Value
'X3 IC5 -- T15 iC5
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
24).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
20).Value
'Y3 NC5 -- U15 nC5
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
25).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
21).Value
'Z3 C6Plus -- V15 C6+
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
26).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
22).Value
'K3 thru Z3
'For j = 11 To 26
' Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r, j).Value
= _
' Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i, j -
4).Value
' Next j

'AA3 Comments -- AF15 Comments
Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r,
27).Value = _
Workbooks(strDataFileName).Sheets(strLookupShtName ).Cells(i,
32).Value
r = r + 1
End If
Next i

'close data file
Workbooks(strDataFileName).Close savechanges:=False

'center text
Range(Cells(intFirstInputRow, 1).Address & ":" & Cells(r,
intLastInputCol).Address).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Range("A1").Select

Application.ScreenUpdating = True
MsgBox "Complete"

'exit sub to skip error handler
exit_ImportData:
Application.ScreenUpdating = True
Range("A1").Select
Exit Sub
err_ImportData:
If bFlag = True And Err.Number = 13 Then
k = 2
Resume Next
Else
MsgBox "An unexpected error occurred. Please contact your file
administrator." & vbCrLf _
& "Error #: " & Err.Number & " Error Desc.: " & Err.Description
& vbCrLf _
& "This procedure will now be terminated."
GoTo exit_ImportData
End If
End Sub


Thanks for the assistance, as always.


 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Input Boxes 4 Inserting A Range In A Formula FARAZ QURESHI Excel Discussion (Misc queries) 5 March 2nd 08 06:30 PM
drop boxes, entering input Chris850 Excel Discussion (Misc queries) 1 September 23rd 06 05:38 PM
How do I put input boxes and sumbit buttons in? mikstr14 New Users to Excel 1 April 10th 06 11:03 PM
How do I add input data in the input ranges in drop down boxes. oil_driller Excel Discussion (Misc queries) 1 November 9th 05 10:31 PM
Input boxes in excel and MS Query David494 Excel Discussion (Misc queries) 0 June 21st 05 03:16 PM


All times are GMT +1. The time now is 10:51 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"