How to move All Data Without Clearing the table

[adam]

I have added a sheet Named “previous” in the workbook attached. The purpose of this sheet is to print previously made invoices.

This sheet is an exact replica of the “NewMemo” sheet

When I click the “Update Log” button in the “NewMemo” sheet after filling all the fields, the data is moved to “OrderData” and “Memos” sheet.
When I press the “Print Previous Memos” button in the “NewMemo” sheet, the sheet gets hidden and it opens the “Previous” sheet, where I want to enter the serial number of a previously made memo.

I have applied VLookup formula to the cells of the “Previous”sheet from the “Memos” sheet and the “CustomerList” sheet.
I have also applied a VB code to the “Previous”sheet. But it does not seem to function well.

What I want to do is when the Serial number is entered in to the “previous” sheet the rest being filled with the appropriate contents from the “OrderData” into the columns of the table in the “Previous” of Code, Category, Description, Rate, Qty, Value & Total.

I have attached the document for your reference.

Thanks in advance.

Regards
Adam

[HansV]

You have changed the position of the fields so the code doesn't use the correct ones. Try this version:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Long
  Dim m As Long
  Dim n As Long
  Dim wsh As Worksheet
  Dim lngSerial As Long
  If Not Intersect(Range("D3"), Target) Is Nothing Then
    Application.EnableEvents = False
    Range("A16:A25").ClearContents
    Range("I16:I25").ClearContents
    lngSerial = Range("D3")
    n = 15
    Set wsh = Worksheets("OrderData")
    m = wsh.Range("A" & wsh.Rows.Count).End(xlUp).Row
    For r = 5 To m
      If wsh.Range("B" & r) = lngSerial Then
        n = n + 1
        Range("A" & n) = wsh.Range("C" & r)
        Range("I" & n) = wsh.Range("G" & r)
      End If
    Next r
    Application.EnableEvents = True
  End If
End Sub

Note: your sheets still contain "TOATL" instead of "TOTAL".

[adam]

It was a piece of cake that I didn't Knew. Thanks Hans for the help. Ill change the TOATL to TOTAL.

[adam]

I have added a new column to the OrderData worksheet. I need help to modify the following code so that when the macro button is clicked the content in cell "J13" of newMemo Sheets gets copied into the sheet "OrderData" column "I" as a string.

I would be pleased if you could help me.

Code: Select all

Sub CopyToDATA()
  Dim r As Long
  Dim m As Long
  Dim n As Long
 
  Dim MemosWks As Worksheet
  Dim NewMemoWks As Worksheet
  Dim OrderWks 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 NewMemo sheet - some contain formulas
  myCopy = "D3,D8,H8,H9,H12,H13,J9,J12,J13,J26,J8,F8,J7"

  Set NewMemoWks = Worksheets("NewMemo")
  Set MemosWks = Worksheets("Memos")
  Set OrderWks = Worksheets("OrderData")

  ' Use column C because column A contains "TOATAL" (and B is empty)
  m = NewMemoWks.Range("I" & NewMemoWks.Rows.Count).End(xlUp).Row
  ' Headers are now in row 4
  If m = 15 Then
    MsgBox "No data", vbExclamation
    Exit Sub
  End If

  r = OrderWks.Range("C" & OrderWks.Rows.Count).End(xlUp).Row + 1
  ' Copy Code
  NewMemoWks.Range("A16:A" & m).Copy Destination:=OrderWks.Range("C" & r)
  ' Copy Quantity
  NewMemoWks.Range("I16:I" & m).Copy Destination:=OrderWks.Range("G" & r)
  ' Copy Category as values
  NewMemoWks.Range("C16:C" & m).Copy
  OrderWks.Range("D" & r & ":D" & (r + m - 16)).PasteSpecial Paste:=xlPasteValues
  ' Copy Description as values
  NewMemoWks.Range("F16:F" & m).Copy
  OrderWks.Range("E" & r & ":E" & (r + m - 16)).PasteSpecial Paste:=xlPasteValues
  ' Copy Rate as values
  NewMemoWks.Range("H16:H" & m).Copy
  OrderWks.Range("F" & r & ":F" & (r + m - 16)).PasteSpecial Paste:=xlPasteValues
  ' Copy Value as values
  NewMemoWks.Range("J16:J" & m).Copy
  OrderWks.Range("H" & r & ":H" & (r + m - 16)).PasteSpecial Paste:=xlPasteValues
  ' Copy Serial number
  OrderWks.Range("B" & r & ":B" & (r + m - 16)) = NewMemoWks.Range("D3")
  ' Copy Date
  NewMemoWks.Range("H12").Copy Destination:=OrderWks.Range("A" & r & ":A" & (r + m - 16))

  OrderWks.Range("A5:H5").Copy
  OrderWks.Range("A" & r & ":H" & (r + m - 16)).PasteSpecial Paste:=xlPasteFormats
  Application.CutCopyMode = False

  With MemosWks
    nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  End With

  With NewMemoWks
    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 MemosWks
    With .Cells(nextRow, "A")
      .Value = Now
      .NumberFormat = "hh:mm:ss"
    End With
    oCol = 2
    For Each myCell In myRng.Cells
      MemosWks.Cells(nextRow, oCol).Value = myCell.Value
      oCol = oCol + 1
    Next myCell
  End With

  With NewMemoWks.Range("D3")
    .Value = .Value + 1
  End With
  NewMemoWks.Range("A16:A" & m & ",I16:I" & m & ",H12").ClearContents
  'clear input cells that contain constants
  With NewMemoWks
  On Error Resume Next
    With .Range("D8,H8,H9,H12,H13,J9,J12,J13,J26,J8,F8,J7").Cells.SpecialCells(xlCellTypeConstants)
     .ClearContents
      Application.GoTo .Cells(1) ', Scroll:=True
    End With
    On Error GoTo 0
  End With
End Sub

[HansV]

As far as I can tell the code already does that...

[adam]

Thanks for the reply Hans. I got it solved.