Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Hi All,
I am so stuck.... I am using the following code to copy a single row from "Sheet1" of the "Copreco Daily Submission" workbook, to the next available row of the "Daily Reading Master Log", of the "Copreco Master Log" workbook. Everything works perfectly well. Problem: I want to add some code (and I don't know where) that makes sure the 'Reading Date' in the row of data in "Sheet1", doesn't match any reading dates in the 'Daily Reading Master Log'. If there is a match, cancel the procedure, otherwises, insert the new reading row as per normal. Additional information: Sheet1, 'Reading Date' is in column A, Row 2 - Always 'Reading Date' in Daily Reading Mater Log, is in column B Any assistance would really be appreciated. Many thanks, '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 ' '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 End Sub -- Carlee |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
On Apr 26, 6:22 pm, Carlee wrote:
Hi All, I am so stuck.... I am using the following code to copy a single row from "Sheet1" of the "Copreco Daily Submission" workbook, to the next available row of the "Daily Reading Master Log", of the "Copreco Master Log" workbook. Everything works perfectly well. Problem: I want to add some code (and I don't know where) that makes sure the 'Reading Date' in the row of data in "Sheet1", doesn't match any reading dates in the 'Daily Reading Master Log'. If there is a match, cancel the procedure, otherwises, insert the new reading row as per normal. Additional information: Sheet1, 'Reading Date' is in column A, Row 2 - Always 'Reading Date' in Daily Reading Mater Log, is in column B Any assistance would really be appreciated. Many thanks, '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 ' '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 End Sub -- Carlee Carlee, There's a lot of code and comments to read through, but why not try loading the "Daily Reading Master Log" dates into an array and then compare the array to the "Reading Date"? If there is a match, Exit the Sub procedure or cancel as desired. For example (code not tested), Dim masterLogDates Dim readingDate Dim a masterLogDates = [range_of_master_log] 'or load the array however you desire readingDate = Range(...).Value For a = LBound(masterLogDates) To UBound(masterLogDates) If readingDate = masterLogDates(a) Then MsgBox "Found a match between the 'reading date' and the 'master log date'." vbOkOnly Exit Sub 'or cancel/don't insert; whatever you want to do End Next Without looking too deep in your code, you could put this step before you "insert the new reading row as per normal." I hope this helps. (You could probably also swing a VLookup function as an alternative way). Matt |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
hi matt,
I am not sure how to construct an array. Can you assist a bit further on how to put the array together? -- Carlee "matt" wrote: On Apr 26, 6:22 pm, Carlee wrote: Hi All, I am so stuck.... I am using the following code to copy a single row from "Sheet1" of the "Copreco Daily Submission" workbook, to the next available row of the "Daily Reading Master Log", of the "Copreco Master Log" workbook. Everything works perfectly well. Problem: I want to add some code (and I don't know where) that makes sure the 'Reading Date' in the row of data in "Sheet1", doesn't match any reading dates in the 'Daily Reading Master Log'. If there is a match, cancel the procedure, otherwises, insert the new reading row as per normal. Additional information: Sheet1, 'Reading Date' is in column A, Row 2 - Always 'Reading Date' in Daily Reading Mater Log, is in column B Any assistance would really be appreciated. Many thanks, '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 ' '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 End Sub -- Carlee Carlee, There's a lot of code and comments to read through, but why not try loading the "Daily Reading Master Log" dates into an array and then compare the array to the "Reading Date"? If there is a match, Exit the Sub procedure or cancel as desired. For example (code not tested), Dim masterLogDates Dim readingDate Dim a masterLogDates = [range_of_master_log] 'or load the array however you desire readingDate = Range(...).Value For a = LBound(masterLogDates) To UBound(masterLogDates) If readingDate = masterLogDates(a) Then MsgBox "Found a match between the 'reading date' and the 'master log date'." vbOkOnly Exit Sub 'or cancel/don't insert; whatever you want to do End Next Without looking too deep in your code, you could put this step before you "insert the new reading row as per normal." I hope this helps. (You could probably also swing a VLookup function as an alternative way). Matt |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
On Apr 26, 8:50 pm, Carlee wrote:
hi matt, I am not sure how to construct an array. Can you assist a bit further on how to put the array together? -- Carlee "matt" wrote: On Apr 26, 6:22 pm, Carlee wrote: Hi All, I am so stuck.... I am using the following code to copy a single row from "Sheet1" of the "Copreco Daily Submission" workbook, to the next available row of the "Daily Reading Master Log", of the "Copreco Master Log" workbook. Everything works perfectly well. Problem: I want to add some code (and I don't know where) that makes sure the 'Reading Date' in the row of data in "Sheet1", doesn't match any reading dates in the 'Daily Reading Master Log'. If there is a match, cancel the procedure, otherwises, insert the new reading row as per normal. Additional information: Sheet1, 'Reading Date' is in column A, Row 2 - Always 'Reading Date' in Daily Reading Mater Log, is in column B Any assistance would really be appreciated. Many thanks, '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 ' '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 End Sub -- Carlee Carlee, There's a lot of code and comments to read through, but why not try loading the "Daily Reading Master Log" dates into an array and then compare the array to the "Reading Date"? If there is a match, Exit the Sub procedure or cancel as desired. For example (code not tested), Dim masterLogDates Dim readingDate Dim a masterLogDates = [range_of_master_log] 'or load the array however you desire readingDate = Range(...).Value For a = LBound(masterLogDates) To UBound(masterLogDates) If readingDate = masterLogDates(a) Then MsgBox "Found a match between the 'reading date' and the 'master log date'." vbOkOnly Exit Sub 'or cancel/don't insert; whatever you want to do End Next Without looking too deep in your code, you could put this step before you "insert the new reading row as per normal." I hope this helps. (You could probably also swing a VLookup function as an alternative way). Matt- Hide quoted text - - Show quoted text - Carlee, I'm not sure how much coding background you have, so I'll list some example code. If you need more explanation then email me at meh2030 at gmail dot com and I'll send you a tutorial I wrote up on loops and arrays. You can define an array as having option base 0 or option base 1. If you do not define the size of the array at declaration, you can define the size with a ReDim statement later on in the program. There are ways that don't require you to define the size (e.g. the Array function or the Evaluate Method), but you'll then need to use the LBound and UBound functions to extract data via a For...Next loop. (As a side note, arrays in Excel can hold up to 60 dimensions. Most people typically won't use arrays larger than 3 dimensions). Here's one example. Option Base 1 Sub testArrayOption() Dim myArray(10) 'this array has 10 elements Dim a For a = 1 To 10 myArray(a) = Cells(a, 1).Value 'Comment: it could be written as myArray(a) = Cells(a, "A").Value 'Comment: it could also be written as myArray(a) = Range("A" & a).Value Next End Sub Here's another example that loads an array and then loops through the array to compare values. The "[...]" are shorthand for the Evaluate method (search Evaluate in VBE). Sub testArray1() Dim myArray Dim myValue Dim a myValue = 10 myArray = Range("A1:A20").Value 'You could use [A1:A20] Range("J1:J20").Value = myArray 'You could use [J1:J20] For a = LBound(myArray) To UBound(myArray) If myArray(a) = myValue Then MsgBox "Found a match!" End If Next End Sub And here's one more example which will select two separate worksheets that are not contiguous; the example uses the Array function (search Array in VBE). Sub arrayOption() Dim myArray myArray = Array(1, 3) Worksheets(myArray).Select End Sub I hope this helps. Matt |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
really stuck... | Excel Programming | |||
Help, please, I'm stuck | Excel Discussion (Misc queries) | |||
stuck | Excel Worksheet Functions | |||
I'm stuck (again) | Excel Programming | |||
Still Stuck | Excel Programming |