Copy Data to the Serial Number Row

[adamsm]

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.
[vba]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
[/vba]

[GTO]

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

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]

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]

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]

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]

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]

Thanks for the reply Mark. Yes that's what I meant.

[GTO]

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]

Thanks for the help Mark. I do appreciate it. The code works fine now.

[adamsm]

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]

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

Yes this is to allow the user to confirm when he is going to change the data.

[GTO]

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]

Thanks for the help. That helped me alot. And I do really appreciate your help.

[GTO]

You are most welcome