PC Review


Reply
Thread Tools Rate Thread

Check for a value before importing a row

 
 
=?Utf-8?B?Q2FybGVl?=
Guest
Posts: n/a
 
      26th Apr 2007
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
 
Reply With Quote
 
 
 
 
=?Utf-8?B?SkxHV2hpeg==?=
Guest
Posts: n/a
 
      26th Apr 2007
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

 
Reply With Quote
 
=?Utf-8?B?TGV1bmc=?=
Guest
Posts: n/a
 
      26th Apr 2007
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

 
Reply With Quote
 
=?Utf-8?B?Q2FybGVl?=
Guest
Posts: n/a
 
      26th Apr 2007
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

 
Reply With Quote
 
=?Utf-8?B?Q2FybGVl?=
Guest
Posts: n/a
 
      26th Apr 2007
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

 
Reply With Quote
 
=?Utf-8?B?Q2FybGVl?=
Guest
Posts: n/a
 
      26th Apr 2007
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

 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


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


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 03:46 AM.