| Home | Forums | Reviews | Articles | Register |
![]() |
| Thread Tools | Rate Thread |
|
|
|
| |
|
=?Utf-8?B?SkxHV2hpeg==?=
Guest
Posts: n/a
|
I did not set up a test on this, so you will have to test it. Let me
know if there is a problem. Assumes both workbooks are open: Sub ckDte() Dim wkb1 as Workbook Dim wkb2 as workbook Set wkb1 = Workbooks("Corpreco Daily Reading Submission.xls") Set wkb2 = workbooks("Corpreco Master Log.xls") myDte = wkb1.Sheets("Sheet1").Cells(2, 1).Value For Each c In wkb2.Sheets("Daily Reading Master Log").Range("B2:B" & Cells _(Rows.Count, 2).End(xlUp).Row) If c = myDte Then MsgBox "Date Found" Exit Sub End If Exit Sub "Carlee" wrote: > Hi everyone, > > I have two workbooks: Source and Destination. > > I use the following code to import a single row of data from Source > workbook, "Copreco Daily Reading Submission" Sheet 1, into the Destination > Workbook, Copreco Master Log, Sheet "Daily Reading Master Log" > > Issue: I need to capture the date value in "Copreco Daily Reading > Submission," Sheet 1 (Column A, Row 2), and make sure "Copreco Master Log", > Sheet "Daily Reading Master Log", Column B, does not contain that date. If > it does, cancel process, otherwise, continue with process. > > I have figured out how to search for a value while in the same the workbook, > but am not sure how to do this with two workbooks. Any assistance would be > really great. > > 'code -------------------------------------------------------------------->> > > Sub CopyFromCoprecoReading() > 'these have to do with THIS workbook > 'name of the sheet to get data from > Const destSheet = "Daily Reading Master Log" ' in HQ master workbook > '**** > 'This is the name you want to give to the > 'NEW workbook created each time to put new data > 'into as set up this code will overwrite any > 'existing file of this name without any warning. > Const newWorkbookName = "Copreco Daily Reading Submission.xls" > Const sourceSheet = "Sheet1" > '**** > Dim sourceBook As String > Dim destBook As String > Dim maxLastRow As Long > Dim destLastRow As Long > Dim pathToUserDesktop As String > Dim filePath As Variant > Dim MLC As Integer ' loop counter > Dim myErrMsg As String > > 'this is the setup to 'map' cells from the > 'Copreco Reading.xls file sheet to different > 'columns in the HQ master workbook worksheet > ' > 'Declare an array to hold the pairs > 'change the 10 to the actual number > 'of cells that are to be copied > Dim Map() As String > 'array elements Map(1,n) will hold > 'the source column ID from Copreco Reading > 'array elements Map(2,n) will hold > 'the column they are to be copied to in > 'the master workbook > > 'determine last possible row number > 'based on version of Excel in use > maxLastRow = GetMaxLastRow() > ' > 'determine how many elements we need in the array > > > If (MsgBox("Import Daily Reading Submission, Continue?", vbYesNo) = vbYes) > Then > > 'borrow destLastRow for a moment > destLastRow = Worksheets("ColumnsMap").Range("B" & > maxLastRow).End(xlUp).Row > ReDim Map(1 To 2, 1 To (destLastRow - 3)) ' presumes row 4 has 1st entry > For MLC = LBound(Map, 2) To UBound(Map, 2) > If IsError(Worksheets("ColumnsMap").Range("B" & (MLC + 3))) Then > Map(1, MLC) = "#NA" ' to flag as problem later > Else > 'seems good to go > Map(1, MLC) = Trim(Worksheets("ColumnsMap").Range("B" & (MLC + > 3))) > End If > If IsError(Worksheets("ColumnsMap").Range("E" & (MLC + 3))) Then > Map(2, MLC) = "#NA" ' to flag as problem later > Else > Map(2, MLC) = Trim(Worksheets("ColumnsMap").Range("E" & (MLC + > 3))) > End If > Next > 'keeps screen from flickering > 'speeds things up also > Application.ScreenUpdating = False > destBook = ThisWorkbook.Name > 'build up the path to the user's desktop > 'based on standard paths and Windows standards > 'path is normally > ' C:\Documents and Settings\username\Desktop > 'our task is to determine the 'username' portion > 'which is the Windows username (login name) which > 'may be different than the Excel UserName > pathToUserDesktop = "C:\Documents and Settings\" & _ > Get_Win_User_Name() & "\Desktop\" & newWorkbookName > ' > 'see if that workbook is where it is supposed to be > ' > sourceBook = Dir$(pathToUserDesktop) > If sourceBook = "" Then > 'it's not on the desktop > 'have the user browse for it > filePath = Application.GetSaveAsFilename > If filePath = False Then > Exit Sub ' user cancelled > End If > pathToUserDesktop = filePath > End If > ' open the 'Copreco Reading.xls' file > Workbooks.Open pathToUserDesktop > sourceBook = ActiveWorkbook.Name > Windows(sourceBook).Activate > Worksheets(sourceSheet).Activate > > 'get back over to this workbook > Windows(destBook).Activate > 'to sheet to add data to > Worksheets(destSheet).Activate > 'find out what row is available > destLastRow = 0 > For MLC = LBound(Map, 2) To UBound(Map, 2) > If Map(2, MLC) <> "#NA" Then > If Range(Map(2, MLC) & maxLastRow).End(xlUp).Row + 1 > > destLastRow Then > destLastRow = Range(Map(2, MLC) & maxLastRow).End(xlUp).Row > + 1 > End If > End If > Next > If destLastRow > maxLastRow Then > MsgBox "No room in HQ Master Sheet to add entry. Aborting > operation.", _ > vbOKOnly + vbCritical, "No Room on Sheet" > Exit Sub > ElseIf destLastRow = 0 Then > 'could not come up with a valid column id for this workbook! > myErrMsg = "A rather serious problem has occured - cannot find > column references for " > myErrMsg = myErrMsg & "the Daily Reading Master Log sheet." & vbCrLf > myErrMsg = myErrMsg & "Data cannot be transferred. Please send a > copy of BOTH " > myErrMsg = myErrMsg & "workbooks (this one and the 'Copreco > Reading.xls' file to:" & vbCrLf > myErrMsg = myErrMsg & "(E-Mail Removed)" > MsgBox myErrMsg, vbOKOnly + vbCritical, "Column ID Error - Aborting!" > Exit Sub > End If > 'copy the data from Copreco Reading.xls to the HQ master book > For MLC = LBound(Map, 2) To UBound(Map, 2) > 'this watches out for #NA entries in the array of column letters > If Map(1, MLC) <> "#NA" And Map(2, MLC) <> "#NA" Then > Workbooks(destBook).Worksheets(destSheet).Range(Map(2, MLC) & > destLastRow).Value = _ > Workbooks(sourceBook).Worksheets(sourceSheet).Range(Map(1, MLC) > & 2).Value > End If > Next > Application.DisplayAlerts = False > 'close the 'Copreco Reading.xls' file > 'w/o saving any changes > Workbooks(sourceBook).Close False > Application.DisplayAlerts = True > 'done > Application.ScreenUpdating = True > MsgBox "Copreco Reading Submission has been added to the Daily Master > Reading Log" > Else > Exit Sub > End If > End Sub > > -- > Carlee |
|
||
|
||||
|
=?Utf-8?B?TGV1bmc=?=
Guest
Posts: n/a
|
Hi
I am trying to help you. where is the code of GetMaxLastRow() method? Leung "Carlee" wrote: > Hi everyone, > > I have two workbooks: Source and Destination. > > I use the following code to import a single row of data from Source > workbook, "Copreco Daily Reading Submission" Sheet 1, into the Destination > Workbook, Copreco Master Log, Sheet "Daily Reading Master Log" > > Issue: I need to capture the date value in "Copreco Daily Reading > Submission," Sheet 1 (Column A, Row 2), and make sure "Copreco Master Log", > Sheet "Daily Reading Master Log", Column B, does not contain that date. If > it does, cancel process, otherwise, continue with process. > > I have figured out how to search for a value while in the same the workbook, > but am not sure how to do this with two workbooks. Any assistance would be > really great. > > 'code -------------------------------------------------------------------->> > > Sub CopyFromCoprecoReading() > 'these have to do with THIS workbook > 'name of the sheet to get data from > Const destSheet = "Daily Reading Master Log" ' in HQ master workbook > '**** > 'This is the name you want to give to the > 'NEW workbook created each time to put new data > 'into as set up this code will overwrite any > 'existing file of this name without any warning. > Const newWorkbookName = "Copreco Daily Reading Submission.xls" > Const sourceSheet = "Sheet1" > '**** > Dim sourceBook As String > Dim destBook As String > Dim maxLastRow As Long > Dim destLastRow As Long > Dim pathToUserDesktop As String > Dim filePath As Variant > Dim MLC As Integer ' loop counter > Dim myErrMsg As String > > 'this is the setup to 'map' cells from the > 'Copreco Reading.xls file sheet to different > 'columns in the HQ master workbook worksheet > ' > 'Declare an array to hold the pairs > 'change the 10 to the actual number > 'of cells that are to be copied > Dim Map() As String > 'array elements Map(1,n) will hold > 'the source column ID from Copreco Reading > 'array elements Map(2,n) will hold > 'the column they are to be copied to in > 'the master workbook > > 'determine last possible row number > 'based on version of Excel in use > maxLastRow = GetMaxLastRow() > ' > 'determine how many elements we need in the array > > > If (MsgBox("Import Daily Reading Submission, Continue?", vbYesNo) = vbYes) > Then > > 'borrow destLastRow for a moment > destLastRow = Worksheets("ColumnsMap").Range("B" & > maxLastRow).End(xlUp).Row > ReDim Map(1 To 2, 1 To (destLastRow - 3)) ' presumes row 4 has 1st entry > For MLC = LBound(Map, 2) To UBound(Map, 2) > If IsError(Worksheets("ColumnsMap").Range("B" & (MLC + 3))) Then > Map(1, MLC) = "#NA" ' to flag as problem later > Else > 'seems good to go > Map(1, MLC) = Trim(Worksheets("ColumnsMap").Range("B" & (MLC + > 3))) > End If > If IsError(Worksheets("ColumnsMap").Range("E" & (MLC + 3))) Then > Map(2, MLC) = "#NA" ' to flag as problem later > Else > Map(2, MLC) = Trim(Worksheets("ColumnsMap").Range("E" & (MLC + > 3))) > End If > Next > 'keeps screen from flickering > 'speeds things up also > Application.ScreenUpdating = False > destBook = ThisWorkbook.Name > 'build up the path to the user's desktop > 'based on standard paths and Windows standards > 'path is normally > ' C:\Documents and Settings\username\Desktop > 'our task is to determine the 'username' portion > 'which is the Windows username (login name) which > 'may be different than the Excel UserName > pathToUserDesktop = "C:\Documents and Settings\" & _ > Get_Win_User_Name() & "\Desktop\" & newWorkbookName > ' > 'see if that workbook is where it is supposed to be > ' > sourceBook = Dir$(pathToUserDesktop) > If sourceBook = "" Then > 'it's not on the desktop > 'have the user browse for it > filePath = Application.GetSaveAsFilename > If filePath = False Then > Exit Sub ' user cancelled > End If > pathToUserDesktop = filePath > End If > ' open the 'Copreco Reading.xls' file > Workbooks.Open pathToUserDesktop > sourceBook = ActiveWorkbook.Name > Windows(sourceBook).Activate > Worksheets(sourceSheet).Activate > > 'get back over to this workbook > Windows(destBook).Activate > 'to sheet to add data to > Worksheets(destSheet).Activate > 'find out what row is available > destLastRow = 0 > For MLC = LBound(Map, 2) To UBound(Map, 2) > If Map(2, MLC) <> "#NA" Then > If Range(Map(2, MLC) & maxLastRow).End(xlUp).Row + 1 > > destLastRow Then > destLastRow = Range(Map(2, MLC) & maxLastRow).End(xlUp).Row > + 1 > End If > End If > Next > If destLastRow > maxLastRow Then > MsgBox "No room in HQ Master Sheet to add entry. Aborting > operation.", _ > vbOKOnly + vbCritical, "No Room on Sheet" > Exit Sub > ElseIf destLastRow = 0 Then > 'could not come up with a valid column id for this workbook! > myErrMsg = "A rather serious problem has occured - cannot find > column references for " > myErrMsg = myErrMsg & "the Daily Reading Master Log sheet." & vbCrLf > myErrMsg = myErrMsg & "Data cannot be transferred. Please send a > copy of BOTH " > myErrMsg = myErrMsg & "workbooks (this one and the 'Copreco > Reading.xls' file to:" & vbCrLf > myErrMsg = myErrMsg & "(E-Mail Removed)" > MsgBox myErrMsg, vbOKOnly + vbCritical, "Column ID Error - Aborting!" > Exit Sub > End If > 'copy the data from Copreco Reading.xls to the HQ master book > For MLC = LBound(Map, 2) To UBound(Map, 2) > 'this watches out for #NA entries in the array of column letters > If Map(1, MLC) <> "#NA" And Map(2, MLC) <> "#NA" Then > Workbooks(destBook).Worksheets(destSheet).Range(Map(2, MLC) & > destLastRow).Value = _ > Workbooks(sourceBook).Worksheets(sourceSheet).Range(Map(1, MLC) > & 2).Value > End If > Next > Application.DisplayAlerts = False > 'close the 'Copreco Reading.xls' file > 'w/o saving any changes > Workbooks(sourceBook).Close False > Application.DisplayAlerts = True > 'done > Application.ScreenUpdating = True > MsgBox "Copreco Reading Submission has been added to the Daily Master > Reading Log" > Else > Exit Sub > End If > End Sub > > -- > Carlee |
|
||
|
||||
|
=?Utf-8?B?Q2FybGVl?=
Guest
Posts: n/a
|
Sorry...here is the code you requested:
Function GetMaxLastRow() As Long If Val(Left(Application.Version, 2)) < 12 Then 'in pre-Excel 2007 version GetMaxLastRow = Rows.Count Else 'in Excel 2007 (or later?) GetMaxLastRow = Rows.CountLarge End If End Function -- Carlee "Leung" wrote: > Hi > > I am trying to help you. > > where is the code of GetMaxLastRow() method? > > Leung > > > "Carlee" wrote: > > > Hi everyone, > > > > I have two workbooks: Source and Destination. > > > > I use the following code to import a single row of data from Source > > workbook, "Copreco Daily Reading Submission" Sheet 1, into the Destination > > Workbook, Copreco Master Log, Sheet "Daily Reading Master Log" > > > > Issue: I need to capture the date value in "Copreco Daily Reading > > Submission," Sheet 1 (Column A, Row 2), and make sure "Copreco Master Log", > > Sheet "Daily Reading Master Log", Column B, does not contain that date. If > > it does, cancel process, otherwise, continue with process. > > > > I have figured out how to search for a value while in the same the workbook, > > but am not sure how to do this with two workbooks. Any assistance would be > > really great. > > > > 'code -------------------------------------------------------------------->> > > > > Sub CopyFromCoprecoReading() > > 'these have to do with THIS workbook > > 'name of the sheet to get data from > > Const destSheet = "Daily Reading Master Log" ' in HQ master workbook > > '**** > > 'This is the name you want to give to the > > 'NEW workbook created each time to put new data > > 'into as set up this code will overwrite any > > 'existing file of this name without any warning. > > Const newWorkbookName = "Copreco Daily Reading Submission.xls" > > Const sourceSheet = "Sheet1" > > '**** > > Dim sourceBook As String > > Dim destBook As String > > Dim maxLastRow As Long > > Dim destLastRow As Long > > Dim pathToUserDesktop As String > > Dim filePath As Variant > > Dim MLC As Integer ' loop counter > > Dim myErrMsg As String > > > > 'this is the setup to 'map' cells from the > > 'Copreco Reading.xls file sheet to different > > 'columns in the HQ master workbook worksheet > > ' > > 'Declare an array to hold the pairs > > 'change the 10 to the actual number > > 'of cells that are to be copied > > Dim Map() As String > > 'array elements Map(1,n) will hold > > 'the source column ID from Copreco Reading > > 'array elements Map(2,n) will hold > > 'the column they are to be copied to in > > 'the master workbook > > > > 'determine last possible row number > > 'based on version of Excel in use > > maxLastRow = GetMaxLastRow() > > ' > > 'determine how many elements we need in the array > > > > > > If (MsgBox("Import Daily Reading Submission, Continue?", vbYesNo) = vbYes) > > Then > > > > 'borrow destLastRow for a moment > > destLastRow = Worksheets("ColumnsMap").Range("B" & > > maxLastRow).End(xlUp).Row > > ReDim Map(1 To 2, 1 To (destLastRow - 3)) ' presumes row 4 has 1st entry > > For MLC = LBound(Map, 2) To UBound(Map, 2) > > If IsError(Worksheets("ColumnsMap").Range("B" & (MLC + 3))) Then > > Map(1, MLC) = "#NA" ' to flag as problem later > > Else > > 'seems good to go > > Map(1, MLC) = Trim(Worksheets("ColumnsMap").Range("B" & (MLC + > > 3))) > > End If > > If IsError(Worksheets("ColumnsMap").Range("E" & (MLC + 3))) Then > > Map(2, MLC) = "#NA" ' to flag as problem later > > Else > > Map(2, MLC) = Trim(Worksheets("ColumnsMap").Range("E" & (MLC + > > 3))) > > End If > > Next > > 'keeps screen from flickering > > 'speeds things up also > > Application.ScreenUpdating = False > > destBook = ThisWorkbook.Name > > 'build up the path to the user's desktop > > 'based on standard paths and Windows standards > > 'path is normally > > ' C:\Documents and Settings\username\Desktop > > 'our task is to determine the 'username' portion > > 'which is the Windows username (login name) which > > 'may be different than the Excel UserName > > pathToUserDesktop = "C:\Documents and Settings\" & _ > > Get_Win_User_Name() & "\Desktop\" & newWorkbookName > > ' > > 'see if that workbook is where it is supposed to be > > ' > > sourceBook = Dir$(pathToUserDesktop) > > If sourceBook = "" Then > > 'it's not on the desktop > > 'have the user browse for it > > filePath = Application.GetSaveAsFilename > > If filePath = False Then > > Exit Sub ' user cancelled > > End If > > pathToUserDesktop = filePath > > End If > > ' open the 'Copreco Reading.xls' file > > Workbooks.Open pathToUserDesktop > > sourceBook = ActiveWorkbook.Name > > Windows(sourceBook).Activate > > Worksheets(sourceSheet).Activate > > > > 'get back over to this workbook > > Windows(destBook).Activate > > 'to sheet to add data to > > Worksheets(destSheet).Activate > > 'find out what row is available > > destLastRow = 0 > > For MLC = LBound(Map, 2) To UBound(Map, 2) > > If Map(2, MLC) <> "#NA" Then > > If Range(Map(2, MLC) & maxLastRow).End(xlUp).Row + 1 > > > destLastRow Then > > destLastRow = Range(Map(2, MLC) & maxLastRow).End(xlUp).Row > > + 1 > > End If > > End If > > Next > > If destLastRow > maxLastRow Then > > MsgBox "No room in HQ Master Sheet to add entry. Aborting > > operation.", _ > > vbOKOnly + vbCritical, "No Room on Sheet" > > Exit Sub > > ElseIf destLastRow = 0 Then > > 'could not come up with a valid column id for this workbook! > > myErrMsg = "A rather serious problem has occured - cannot find > > column references for " > > myErrMsg = myErrMsg & "the Daily Reading Master Log sheet." & vbCrLf > > myErrMsg = myErrMsg & "Data cannot be transferred. Please send a > > copy of BOTH " > > myErrMsg = myErrMsg & "workbooks (this one and the 'Copreco > > Reading.xls' file to:" & vbCrLf > > myErrMsg = myErrMsg & "(E-Mail Removed)" > > MsgBox myErrMsg, vbOKOnly + vbCritical, "Column ID Error - Aborting!" > > Exit Sub > > End If > > 'copy the data from Copreco Reading.xls to the HQ master book > > For MLC = LBound(Map, 2) To UBound(Map, 2) > > 'this watches out for #NA entries in the array of column letters > > If Map(1, MLC) <> "#NA" And Map(2, MLC) <> "#NA" Then > > Workbooks(destBook).Worksheets(destSheet).Range(Map(2, MLC) & > > destLastRow).Value = _ > > Workbooks(sourceBook).Worksheets(sourceSheet).Range(Map(1, MLC) > > & 2).Value > > End If > > Next > > Application.DisplayAlerts = False > > 'close the 'Copreco Reading.xls' file > > 'w/o saving any changes > > Workbooks(sourceBook).Close False > > Application.DisplayAlerts = True > > 'done > > Application.ScreenUpdating = True > > MsgBox "Copreco Reading Submission has been added to the Daily Master > > Reading Log" > > Else > > Exit Sub > > End If > > End Sub > > > > -- > > Carlee |
|
||
|
||||
|
=?Utf-8?B?Q2FybGVl?=
Guest
Posts: n/a
|
Hi JLGWhiz,
I applied the sub procedure, and i got the following error: Variable not Defined, and stops at 'myDate' -- Carlee "JLGWhiz" wrote: > I did not set up a test on this, so you will have to test it. Let me > know if there is a problem. > > Assumes both workbooks are open: > Sub ckDte() > Dim wkb1 as Workbook > Dim wkb2 as workbook > Set wkb1 = Workbooks("Corpreco Daily Reading Submission.xls") > Set wkb2 = workbooks("Corpreco Master Log.xls") > myDte = wkb1.Sheets("Sheet1").Cells(2, 1).Value > For Each c In wkb2.Sheets("Daily Reading Master Log").Range("B2:B" & Cells > _(Rows.Count, 2).End(xlUp).Row) > If c = myDte Then > MsgBox "Date Found" > Exit Sub > End If > Exit Sub > > "Carlee" wrote: > > > Hi everyone, > > > > I have two workbooks: Source and Destination. > > > > I use the following code to import a single row of data from Source > > workbook, "Copreco Daily Reading Submission" Sheet 1, into the Destination > > Workbook, Copreco Master Log, Sheet "Daily Reading Master Log" > > > > Issue: I need to capture the date value in "Copreco Daily Reading > > Submission," Sheet 1 (Column A, Row 2), and make sure "Copreco Master Log", > > Sheet "Daily Reading Master Log", Column B, does not contain that date. If > > it does, cancel process, otherwise, continue with process. > > > > I have figured out how to search for a value while in the same the workbook, > > but am not sure how to do this with two workbooks. Any assistance would be > > really great. > > > > 'code -------------------------------------------------------------------->> > > > > Sub CopyFromCoprecoReading() > > 'these have to do with THIS workbook > > 'name of the sheet to get data from > > Const destSheet = "Daily Reading Master Log" ' in HQ master workbook > > '**** > > 'This is the name you want to give to the > > 'NEW workbook created each time to put new data > > 'into as set up this code will overwrite any > > 'existing file of this name without any warning. > > Const newWorkbookName = "Copreco Daily Reading Submission.xls" > > Const sourceSheet = "Sheet1" > > '**** > > Dim sourceBook As String > > Dim destBook As String > > Dim maxLastRow As Long > > Dim destLastRow As Long > > Dim pathToUserDesktop As String > > Dim filePath As Variant > > Dim MLC As Integer ' loop counter > > Dim myErrMsg As String > > > > 'this is the setup to 'map' cells from the > > 'Copreco Reading.xls file sheet to different > > 'columns in the HQ master workbook worksheet > > ' > > 'Declare an array to hold the pairs > > 'change the 10 to the actual number > > 'of cells that are to be copied > > Dim Map() As String > > 'array elements Map(1,n) will hold > > 'the source column ID from Copreco Reading > > 'array elements Map(2,n) will hold > > 'the column they are to be copied to in > > 'the master workbook > > > > 'determine last possible row number > > 'based on version of Excel in use > > maxLastRow = GetMaxLastRow() > > ' > > 'determine how many elements we need in the array > > > > > > If (MsgBox("Import Daily Reading Submission, Continue?", vbYesNo) = vbYes) > > Then > > > > 'borrow destLastRow for a moment > > destLastRow = Worksheets("ColumnsMap").Range("B" & > > maxLastRow).End(xlUp).Row > > ReDim Map(1 To 2, 1 To (destLastRow - 3)) ' presumes row 4 has 1st entry > > For MLC = LBound(Map, 2) To UBound(Map, 2) > > If IsError(Worksheets("ColumnsMap").Range("B" & (MLC + 3))) Then > > Map(1, MLC) = "#NA" ' to flag as problem later > > Else > > 'seems good to go > > Map(1, MLC) = Trim(Worksheets("ColumnsMap").Range("B" & (MLC + > > 3))) > > End If > > If IsError(Worksheets("ColumnsMap").Range("E" & (MLC + 3))) Then > > Map(2, MLC) = "#NA" ' to flag as problem later > > Else > > Map(2, MLC) = Trim(Worksheets("ColumnsMap").Range("E" & (MLC + > > 3))) > > End If > > Next > > 'keeps screen from flickering > > 'speeds things up also > > Application.ScreenUpdating = False > > destBook = ThisWorkbook.Name > > 'build up the path to the user's desktop > > 'based on standard paths and Windows standards > > 'path is normally > > ' C:\Documents and Settings\username\Desktop > > 'our task is to determine the 'username' portion > > 'which is the Windows username (login name) which > > 'may be different than the Excel UserName > > pathToUserDesktop = "C:\Documents and Settings\" & _ > > Get_Win_User_Name() & "\Desktop\" & newWorkbookName > > ' > > 'see if that workbook is where it is supposed to be > > ' > > sourceBook = Dir$(pathToUserDesktop) > > If sourceBook = "" Then > > 'it's not on the desktop > > 'have the user browse for it > > filePath = Application.GetSaveAsFilename > > If filePath = False Then > > Exit Sub ' user cancelled > > End If > > pathToUserDesktop = filePath > > End If > > ' open the 'Copreco Reading.xls' file > > Workbooks.Open pathToUserDesktop > > sourceBook = ActiveWorkbook.Name > > Windows(sourceBook).Activate > > Worksheets(sourceSheet).Activate > > > > 'get back over to this workbook > > Windows(destBook).Activate > > 'to sheet to add data to > > Worksheets(destSheet).Activate > > 'find out what row is available > > destLastRow = 0 > > For MLC = LBound(Map, 2) To UBound(Map, 2) > > If Map(2, MLC) <> "#NA" Then > > If Range(Map(2, MLC) & maxLastRow).End(xlUp).Row + 1 > > > destLastRow Then > > destLastRow = Range(Map(2, MLC) & maxLastRow).End(xlUp).Row > > + 1 > > End If > > End If > > Next > > If destLastRow > maxLastRow Then > > MsgBox "No room in HQ Master Sheet to add entry. Aborting > > operation.", _ > > vbOKOnly + vbCritical, "No Room on Sheet" > > Exit Sub > > ElseIf destLastRow = 0 Then > > 'could not come up with a valid column id for this workbook! > > myErrMsg = "A rather serious problem has occured - cannot find > > column references for " > > myErrMsg = myErrMsg & "the Daily Reading Master Log sheet." & vbCrLf > > myErrMsg = myErrMsg & "Data cannot be transferred. Please send a > > copy of BOTH " > > myErrMsg = myErrMsg & "workbooks (this one and the 'Copreco > > Reading.xls' file to:" & vbCrLf > > myErrMsg = myErrMsg & "(E-Mail Removed)" > > MsgBox myErrMsg, vbOKOnly + vbCritical, "Column ID Error - Aborting!" > > Exit Sub > > End If > > 'copy the data from Copreco Reading.xls to the HQ master book > > For MLC = LBound(Map, 2) To UBound(Map, 2) > > 'this watches out for #NA entries in the array of column letters > > If Map(1, MLC) <> "#NA" And Map(2, MLC) <> "#NA" Then > > Workbooks(destBook).Worksheets(destSheet).Range(Map(2, MLC) & > > destLastRow).Value = _ > > Workbooks(sourceBook).Worksheets(sourceSheet).Range(Map(1, MLC) > > & 2).Value > > End If > > Next > > Application.DisplayAlerts = False > > 'close the 'Copreco Reading.xls' file > > 'w/o saving any changes > > Workbooks(sourceBook).Close False > > Application.DisplayAlerts = True > > 'done > > Application.ScreenUpdating = True > > MsgBox "Copreco Reading Submission has been added to the Daily Master > > Reading Log" > > Else > > Exit Sub > > End If > > End Sub > > > > -- > > Carlee |
|
||
|
||||
|
=?Utf-8?B?Q2FybGVl?=
Guest
Posts: n/a
|
Me again,
I also get an error that states 'For without Next'... -- Carlee "JLGWhiz" wrote: > I did not set up a test on this, so you will have to test it. Let me > know if there is a problem. > > Assumes both workbooks are open: > Sub ckDte() > Dim wkb1 as Workbook > Dim wkb2 as workbook > Set wkb1 = Workbooks("Corpreco Daily Reading Submission.xls") > Set wkb2 = workbooks("Corpreco Master Log.xls") > myDte = wkb1.Sheets("Sheet1").Cells(2, 1).Value > For Each c In wkb2.Sheets("Daily Reading Master Log").Range("B2:B" & Cells > _(Rows.Count, 2).End(xlUp).Row) > If c = myDte Then > MsgBox "Date Found" > Exit Sub > End If > Exit Sub > > "Carlee" wrote: > > > Hi everyone, > > > > I have two workbooks: Source and Destination. > > > > I use the following code to import a single row of data from Source > > workbook, "Copreco Daily Reading Submission" Sheet 1, into the Destination > > Workbook, Copreco Master Log, Sheet "Daily Reading Master Log" > > > > Issue: I need to capture the date value in "Copreco Daily Reading > > Submission," Sheet 1 (Column A, Row 2), and make sure "Copreco Master Log", > > Sheet "Daily Reading Master Log", Column B, does not contain that date. If > > it does, cancel process, otherwise, continue with process. > > > > I have figured out how to search for a value while in the same the workbook, > > but am not sure how to do this with two workbooks. Any assistance would be > > really great. > > > > 'code -------------------------------------------------------------------->> > > > > Sub CopyFromCoprecoReading() > > 'these have to do with THIS workbook > > 'name of the sheet to get data from > > Const destSheet = "Daily Reading Master Log" ' in HQ master workbook > > '**** > > 'This is the name you want to give to the > > 'NEW workbook created each time to put new data > > 'into as set up this code will overwrite any > > 'existing file of this name without any warning. > > Const newWorkbookName = "Copreco Daily Reading Submission.xls" > > Const sourceSheet = "Sheet1" > > '**** > > Dim sourceBook As String > > Dim destBook As String > > Dim maxLastRow As Long > > Dim destLastRow As Long > > Dim pathToUserDesktop As String > > Dim filePath As Variant > > Dim MLC As Integer ' loop counter > > Dim myErrMsg As String > > > > 'this is the setup to 'map' cells from the > > 'Copreco Reading.xls file sheet to different > > 'columns in the HQ master workbook worksheet > > ' > > 'Declare an array to hold the pairs > > 'change the 10 to the actual number > > 'of cells that are to be copied > > Dim Map() As String > > 'array elements Map(1,n) will hold > > 'the source column ID from Copreco Reading > > 'array elements Map(2,n) will hold > > 'the column they are to be copied to in > > 'the master workbook > > > > 'determine last possible row number > > 'based on version of Excel in use > > maxLastRow = GetMaxLastRow() > > ' > > 'determine how many elements we need in the array > > > > > > If (MsgBox("Import Daily Reading Submission, Continue?", vbYesNo) = vbYes) > > Then > > > > 'borrow destLastRow for a moment > > destLastRow = Worksheets("ColumnsMap").Range("B" & > > maxLastRow).End(xlUp).Row > > ReDim Map(1 To 2, 1 To (destLastRow - 3)) ' presumes row 4 has 1st entry > > For MLC = LBound(Map, 2) To UBound(Map, 2) > > If IsError(Worksheets("ColumnsMap").Range("B" & (MLC + 3))) Then > > Map(1, MLC) = "#NA" ' to flag as problem later > > Else > > 'seems good to go > > Map(1, MLC) = Trim(Worksheets("ColumnsMap").Range("B" & (MLC + > > 3))) > > End If > > If IsError(Worksheets("ColumnsMap").Range("E" & (MLC + 3))) Then > > Map(2, MLC) = "#NA" ' to flag as problem later > > Else > > Map(2, MLC) = Trim(Worksheets("ColumnsMap").Range("E" & (MLC + > > 3))) > > End If > > Next > > 'keeps screen from flickering > > 'speeds things up also > > Application.ScreenUpdating = False > > destBook = ThisWorkbook.Name > > 'build up the path to the user's desktop > > 'based on standard paths and Windows standards > > 'path is normally > > ' C:\Documents and Settings\username\Desktop > > 'our task is to determine the 'username' portion > > 'which is the Windows username (login name) which > > 'may be different than the Excel UserName > > pathToUserDesktop = "C:\Documents and Settings\" & _ > > Get_Win_User_Name() & "\Desktop\" & newWorkbookName > > ' > > 'see if that workbook is where it is supposed to be > > ' > > sourceBook = Dir$(pathToUserDesktop) > > If sourceBook = "" Then > > 'it's not on the desktop > > 'have the user browse for it > > filePath = Application.GetSaveAsFilename > > If filePath = False Then > > Exit Sub ' user cancelled > > End If > > pathToUserDesktop = filePath > > End If > > ' open the 'Copreco Reading.xls' file > > Workbooks.Open pathToUserDesktop > > sourceBook = ActiveWorkbook.Name > > Windows(sourceBook).Activate > > Worksheets(sourceSheet).Activate > > > > 'get back over to this workbook > > Windows(destBook).Activate > > 'to sheet to add data to > > Worksheets(destSheet).Activate > > 'find out what row is available > > destLastRow = 0 > > For MLC = LBound(Map, 2) To UBound(Map, 2) > > If Map(2, MLC) <> "#NA" Then > > If Range(Map(2, MLC) & maxLastRow).End(xlUp).Row + 1 > > > destLastRow Then > > destLastRow = Range(Map(2, MLC) & maxLastRow).End(xlUp).Row > > + 1 > > End If > > End If > > Next > > If destLastRow > maxLastRow Then > > MsgBox "No room in HQ Master Sheet to add entry. Aborting > > operation.", _ > > vbOKOnly + vbCritical, "No Room on Sheet" > > Exit Sub > > ElseIf destLastRow = 0 Then > > 'could not come up with a valid column id for this workbook! > > myErrMsg = "A rather serious problem has occured - cannot find > > column references for " > > myErrMsg = myErrMsg & "the Daily Reading Master Log sheet." & vbCrLf > > myErrMsg = myErrMsg & "Data cannot be transferred. Please send a > > copy of BOTH " > > myErrMsg = myErrMsg & "workbooks (this one and the 'Copreco > > Reading.xls' file to:" & vbCrLf > > myErrMsg = myErrMsg & "(E-Mail Removed)" > > MsgBox myErrMsg, vbOKOnly + vbCritical, "Column ID Error - Aborting!" > > Exit Sub > > End If > > 'copy the data from Copreco Reading.xls to the HQ master book > > For MLC = LBound(Map, 2) To UBound(Map, 2) > > 'this watches out for #NA entries in the array of column letters > > If Map(1, MLC) <> "#NA" And Map(2, MLC) <> "#NA" Then > > Workbooks(destBook).Worksheets(destSheet).Range(Map(2, MLC) & > > destLastRow).Value = _ > > Workbooks(sourceBook).Worksheets(sourceSheet).Range(Map(1, MLC) > > & 2).Value > > End If > > Next > > Application.DisplayAlerts = False > > 'close the 'Copreco Reading.xls' file > > 'w/o saving any changes > > Workbooks(sourceBook).Close False > > Application.DisplayAlerts = True > > 'done > > Application.ScreenUpdating = True > > MsgBox "Copreco Reading Submission has been added to the Daily Master > > Reading Log" > > Else > > Exit Sub > > End If > > End Sub > > > > -- > > Carlee |
|
||
|
||||
|
|
|
| |
![]() |
| Thread Tools | |
| Rate This Thread | |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| check excel before importing | eighthman11 | Microsoft Access | 4 | 10th Dec 2008 05:01 PM |
| Importing Alan Beban's code on Arrays; Importing a module or a project | Steve G | Microsoft Excel Worksheet Functions | 4 | 27th Aug 2007 04:18 PM |
| Importing contacts from Excel-address not importing - city,st&zip | =?Utf-8?B?andj?= | Microsoft Outlook BCM | 1 | 18th Feb 2006 12:11 AM |
| Check if file exists before importing it | =?Utf-8?B?SWFu?= | Microsoft Access VBA Modules | 2 | 23rd Sep 2005 07:47 PM |
| Check before Importing txt file | Junior | Microsoft Access Form Coding | 1 | 24th Jul 2005 02:51 AM |
Powered by vBulletin®. Copyright ©2000 - 2012, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2010, Crawlability, Inc. |




