Really Stuck, Please Help

[Carlee]

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 & "(e-mail address 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
End Sub

 

[matt]

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 & "(e-mail address 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
End Sub

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

 

[Carlee]

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

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 & "(e-mail address 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
End Sub

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

 

[matt]

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

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