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 |
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 |