Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Input Boxes 4 Inserting A Range In A Formula | Excel Discussion (Misc queries) | |||
drop boxes, entering input | Excel Discussion (Misc queries) | |||
How do I put input boxes and sumbit buttons in? | New Users to Excel | |||
How do I add input data in the input ranges in drop down boxes. | Excel Discussion (Misc queries) | |||
Input boxes in excel and MS Query | Excel Discussion (Misc queries) |