Input boxes

J

James

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_ImportDat
'*******************************************************************************
'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(strLookupShtName).Cells(i,
4).Value), _
Day(Workbooks(strDataFileName).Sheets(strLookupShtName).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.
 
G

Gary''s Student

With Workbooks(strInitFileName).Sheets(strInitShtName).Cells(r, 5)
..Value = Application.InputBox(Prompt:="Enter Initials ", Type:=2)
End With
 
J

James

It works, however it is asking me to input initials for every entry there
that is on my Data Source workbook. Is there way to get this InputBox to
just ask once for the initals than it would populate the rest of my template
workbook.

Thanks again.
 
G

Gary''s Student

Near the very top of your code:

Dim sInitials as String
sInitials=Application.InputBox(Prompt:="Enter Initials ", Type:=2)

and then use:

..Value=sInitials
in place of:
..Value = Application.InputBox(Prompt:="Enter Initials ", Type:=2)
 
J

James

I just needed to take out the "with" and "End with", other than that it works
great. It should make this importing of data more flexiable for anyone else
that was to do this here at my work.

I need to learn more about these InputBoxes I can see where they can be
benefical in a lot of ways.

Thanks again.
 
G

Gary''s Student

I agree that Aplication.InputBox is useful. Especially Type:=8, which allows
the user to select a range with either mouse or keyboard.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Formula Help 6
MsgBox in another Instance of Excel 4
PROGRESS BAR 2
Code does not error but no copy either 4
Print Directory to Excel 13
Need Help with ActiveCell.EntireRow.Delete 8
Open four Wbooks, copy four columns from each to Master Wbook 16
Excel How to run multiple Private Sub Worksheet_Change(ByVal Target As Range) 0

Top