PDA

View Full Version : Copy Data to the Serial Number Row



adamsm
02-15-2011, 09:24 AM
Hi,

I'm using the following code to add data rows to the sheet Invoice from the sheet Previous.

The code adds data rows one row below the other each time the code is run.

What I'm trying to get is to find a way so that the code would save the data rows to a existing data row.

Lets say for example; cell O6 of the sheet Previous has 0001 and row 6, column B of the sheet Ivoice has 0001.

With this situation when the user runs the macro, the cell contents listed in the code would get copied to the row where the serial number 0001 exists.

I hope I've made my question clear.

Any help on this would be kindly appreciated.

Thanks in advance.
Sub EditSheet()
On Error Resume Next
Application.ScreenUpdating = False

Dim r As Long
Dim m As Long
Dim n As Long

Dim InvoiceWks As Worksheet
Dim PreviousWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myRng As Range
Dim myCopy As String
Dim myCell As Range

'cells to copy from Previous sheet
myCopy = "O6,I10,M10,M11,M14,M15,O11,O14,O15,O38,O10,M9,O9,I9"

Set PreviousWks = Worksheets("Previous")
Set InvoiceWks = Worksheets("Invoice")

With PreviousWks
Set myRng = .Range(myCopy)

If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in all the fields!"
Exit Sub
End If
End With
With InvoiceWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With

With InvoiceWks
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "hh:mm:ss"
End With
oCol = 2
For Each myCell In myRng.Cells
InvoiceWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With
ThisWorkbook.Save
Application.ScreenUpdating = True
End Sub

GTO
02-15-2011, 09:36 AM
...Lets say for example; cell O6 of the sheet Previous has 0001 and row 6, column B of the sheet Ivoice has 0001.

With this situation when the user runs the macro, the cell contents listed in the code would get copied to the row where the serial number 0001 exists....

Hi Adam,

I would presume that cell O6 is formatted for text?

I think that if you tacked in a sample workbook, with some fake data that replicates the actual data types, it would be easier to see what you want.

Mark

adamsm
02-15-2011, 09:55 AM
Thanks for the reply Mark. I've attached a sample workbook. In the "Previous" sheet you would see the serial number as 0131 in cell O6. And in the "Invoice" sheet you would see a data row with the same serial number initially being saved in row 4.

What I'm trying to get is when the user edits any of the fields in the "Previous" sheet and run the macro, the edited fields get copied to the row where the serial number 0131 exists.

The user cannot edit the serial number. But can edit the rest of the cells in the previous sheet.

I hope this makes my question clear.

GTO
02-15-2011, 11:06 AM
Hi Adam,

Using your present code, I think we could just see if the serial number exists in the destination sheet, and if so, set nextrow to this row number. Does this help, or am I missing what you are wanting to do?

Sub EditSheet()

Dim r As Long
Dim m As Long
Dim n As Long

Dim InvoiceWks As Worksheet
Dim PreviousWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myRng As Range
Dim myCopy As String
Dim myCell As Range

Dim rngTemp As Range

Application.ScreenUpdating = False
'cells to copy from Previous sheet
myCopy = "O6,I10,M10,M11,M14,M15,O11,O14,O15,O38,O10,M9,O9,I9"

Set PreviousWks = Worksheets("Previous")
Set InvoiceWks = Worksheets("Invoice")

With PreviousWks
Set myRng = .Range(myCopy)

If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in all the fields!"
Exit Sub
End If
End With

With InvoiceWks

Set rngTemp = RangeFound(SearchRange:=Range(.Range("B4"), .Cells(.Rows.Count, "B")), _
FindWhat:=PreviousWks.Range("O6").Text, _
LookAtWholeOrPart:=xlWhole)
If Not rngTemp Is Nothing Then
nextRow = rngTemp.Row
Else
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End If
End With

With InvoiceWks
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "hh:mm:ss"
End With

oCol = 2

For Each myCell In myRng.Cells
InvoiceWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With

ThisWorkbook.Save
Application.ScreenUpdating = True
End Sub

Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

Mark

GTO
02-15-2011, 11:08 AM
PS - you had an 'On Error Resume Next' in there, that I did not see a reason for. This can mask problems, and IMO, should only be used for as many lines as absolutely necessary; and only as a way of handling an expected error.

adamsm
02-15-2011, 12:09 PM
Thanks for the help Mark. It does the job that I had requested. & I do really appreciate it. One more help If I may ask I do not want the time to get saved to the column A instead keep the already saved time as it is. and copy the rest of the cell contents to appropriate columns.

How shall I remove the line and make so?

I hope I've made my question clear.

GTO
02-16-2011, 02:59 AM
Sorry, for clarity (mine only):

Are you saying that if we find a pre-existing record, update everything except the time, which we want to keep as an initial time hack on the record?

adamsm
02-16-2011, 09:22 AM
Thanks for the reply Mark. Yes that's what I meant.

GTO
02-17-2011, 12:31 AM
Okay, try:

With the other procedural level variable deeclarations add:

Dim bolTimeStampRecord As Boolean

In the porcedure, change just this part to set/test a flag to see if we created a new record:

With InvoiceWks

Set rngTemp = RangeFound(SearchRange:=Range(.Range("B4"), .Cells(.Rows.Count, "B")), _
FindWhat:=PreviousWks.Range("O6").Text, _
LookAtWholeOrPart:=xlWhole)
If Not rngTemp Is Nothing Then
nextRow = rngTemp.Row
Else
bolTimeStampRecord = True
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End If
End With

With InvoiceWks
If bolTimeStampRecord Then
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "hh:mm:ss"
End With
End If

oCol = 2

For Each myCell In myRng.Cells
InvoiceWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With

Mark

adamsm
02-17-2011, 11:53 AM
Thanks for the help Mark. I do appreciate it. The code works fine now.

adamsm
03-04-2011, 03:36 AM
One more help if I may ask;

How could I create a message box as
If MsgBox("Overwrite InvoiceData?", vbYesNo) = vbNo Then

When ever the user changes the values in cell and runs the macro

Sub EditSheet().

I mean where should I place the above line in the code provided so that whenever a user tries to save data to a row where the serial number already exsts; excel would open the message box?

I hope I've made my question clear.

Any help on this would be kindly appreciated.

GTO
03-04-2011, 03:48 AM
...How could I create a message box as
If MsgBox("Overwrite InvoiceData?", vbYesNo) = vbNo Then...

...I mean where should I place the above line in the code provided so that whenever a user tries to save data to a row where the serial number already exsts; excel would open the message box?...

Hi Adam,

If the user selects <NO>, are we just cancelling the operation outright, in order to prevent an unintentional overwriting of the previously saved data?

Mark

adamsm
03-04-2011, 07:38 AM
Yes this is to allow the user to confirm when he is going to change the data.

GTO
03-04-2011, 08:18 AM
Not tested, but I think...

Sub EditSheet()

Dim r As Long
Dim m As Long
Dim n As Long

Dim InvoiceWks As Worksheet
Dim PreviousWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myRng As Range
Dim myCopy As String
Dim myCell As Range

Dim rngTemp As Range
Dim bolTimeStampRecord As Boolean

Application.ScreenUpdating = False
'cells to copy from Previous sheet
myCopy = "O6,I10,M10,M11,M14,M15,O11,O14,O15,O38,O10,M9,O9,I9"

Set PreviousWks = Worksheets("Previous")
Set InvoiceWks = Worksheets("Invoice")

With PreviousWks
Set myRng = .Range(myCopy)

If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in all the fields!"
Exit Sub
End If
End With

With InvoiceWks

Set rngTemp = RangeFound(SearchRange:=Range(.Range("B4"), .Cells(.Rows.Count, "B")), _
FindWhat:=PreviousWks.Range("O6").Text, _
LookAtWholeOrPart:=xlWhole)
If Not rngTemp Is Nothing Then
nextRow = rngTemp.Row
Else
bolTimeStampRecord = True
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End If
End With

With InvoiceWks
If bolTimeStampRecord Then
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "hh:mm:ss"
End With

oCol = 2

For Each myCell In myRng.Cells
InvoiceWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell

ThisWorkbook.Save
Else
If MsgBox("Do you want to update the current record?", vbQuestion, vbNullString) = vbYes Then

oCol = 2

For Each myCell In myRng.Cells
InvoiceWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End If

ThisWorkbook.Save
End With

Application.ScreenUpdating = True
End Sub

Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

Hope that helps,

Mark

adamsm
03-04-2011, 08:52 AM
Thanks for the help. That helped me alot. And I do really appreciate your help.

GTO
03-04-2011, 09:08 AM
You are most welcome :friends: