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. |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
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. |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
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. |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 _ |
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
#6
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
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) |