Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Check for a value before importing a row
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 & " 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(Ma p(2, MLC) & destLastRow).Value = _ Workbooks(sourceBook).Worksheets(sourceSheet).Rang e(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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Check for a value before importing a row
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 & " 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(Ma p(2, MLC) & destLastRow).Value = _ Workbooks(sourceBook).Worksheets(sourceSheet).Rang e(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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Check for a value before importing a row
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 & " 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(Ma p(2, MLC) & destLastRow).Value = _ Workbooks(sourceBook).Worksheets(sourceSheet).Rang e(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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Check for a value before importing a row
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 & " 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(Ma p(2, MLC) & destLastRow).Value = _ Workbooks(sourceBook).Worksheets(sourceSheet).Rang e(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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Check for a value before importing a row
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 & " 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(Ma p(2, MLC) & destLastRow).Value = _ Workbooks(sourceBook).Worksheets(sourceSheet).Rang e(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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Check for a value before importing a row
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 & " 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(Ma p(2, MLC) & destLastRow).Value = _ Workbooks(sourceBook).Worksheets(sourceSheet).Rang e(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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copy and move check box (check boxes) with new cell link? | Excel Worksheet Functions | |||
Importing Alan Beban's code on Arrays; Importing a module or a project | Excel Worksheet Functions | |||
Increase size of a Forms Check Box (click on to enter check mark) | Excel Discussion (Misc queries) | |||
Check if Conditional Format is True or False / Check cell Color | Excel Worksheet Functions | |||
Enable check box in protected sheet + group check boxes | Excel Discussion (Misc queries) |