Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Discussion (Misc queries) > Input boxes
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #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.


Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 11,058
Default Input boxes
With Workbooks(strInitFileName).Sheets(strInitShtName). Cells(r, 5)
..Value = Application.InputBox(Prompt:="Enter Initials ", Type:=2)
End With

--
Gary''s Student - gsnu200796


"James" wrote:

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.


Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 542
Default Input boxes
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.

"Gary''s Student" wrote:

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

--
Gary''s Student - gsnu200796


"James" wrote:

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.


Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 11,058
Default Input boxes
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)
--
Gary''s Student - gsnu200796


"James" wrote:

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.

"Gary''s Student" wrote:

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

--
Gary''s Student - gsnu200796


"James" wrote:

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 _
Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 542
Default Input boxes
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.

"Gary''s Student" wrote:

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)
--
Gary''s Student - gsnu200796


"James" wrote:

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.

"Gary''s Student" wrote:

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

--
Gary''s Student - gsnu200796


"James" wrote:

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
Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 11,058
Default Input boxes
I agree that Aplication.InputBox is useful. Especially Type:=8, which allows
the user to select a range with either mouse or keyboard.
--
Gary''s Student - gsnu200796


"James" wrote:

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.

"Gary''s Student" wrote:

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)
--
Gary''s Student - gsnu200796


"James" wrote:

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.

"Gary''s Student" wrote:

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

--
Gary''s Student - gsnu200796


"James" wrote:

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
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

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 03:02 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"

 

Contact Us ExcelBanter forum home Privacy Statement