VB Code to copy data from one sheet to another sheet

Ateeb Ali · Nov 5, 2019

Dear Sir
File Enclosed, it has two sheets "DC" and "DC Records"
Getting some error on "save records" button, it is not copying UOM and quantities, also pasting my code below;

Code:

Sub Save_Data()
Dim rng As Range
  Dim i As Long
  Dim a As Long
  Dim rng_dest As Range
  Application.ScreenUpdating = False
  i = 1
  Set rng_dest = Sheets("DC Record").Range("E:G")
  ' Find first empty row in columns E:G on sheet DC Record
  Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
  Loop
  'Copy range C13:I23 on sheet DC to Variant array
  Set rng = Sheets("DC").Range("C13:I23")
    ' Copy rows containing values to sheet DC Record
  For a = 1 To rng.Rows.Count
    If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
      rng_dest.Rows(i).Value = rng.Rows(a).Value
      'Copy DC number
      Sheets("DC Record").Range("A" & i).Value = Sheets("DC").Range("I5").Value
      'Copy Date
      Sheets("DC Record").Range("B" & i).Value = Sheets("DC").Range("C5").Value
      'Copy Customer
      Sheets("DC Record").Range("C" & i).Value = Sheets("DC").Range("D7").Value
      'Copy P.O number
      Sheets("DC Record").Range("D" & i).Value = Sheets("DC").Range("H7").Value
      
    i = i + 1
    End If
  Next a
  Application.ScreenUpdating = True

End Sub

Marc L · Nov 5, 2019

Hi !

~~That's normal as you forgot in your code these columns, just amend it accordingly …~~

Ateeb Ali · Nov 5, 2019

Dear Sir
Sorry dont understand, I have mentioned it in my code like UOM and quantities to be copied from "Sheet DC RANGE(H13:I23)" and to be paste in "Sheet DC Record RANGE (F:G)"
Can you please amend in my code

Marc L · Nov 5, 2019

~~In which codeline did you « mentioned it » ?!~~

~~As I yet wrote you just forgot it …~~

Tips fo beginners :

Do not ever merge cells for a smart worksheet, that's easier to manage under VBA.
A smart worksheet does not have empty rows within a data range but use Excel tables …

Ateeb Ali · Nov 5, 2019

Marc L said:
In which codeline did you « mentioned it » ?! As I yet wrote you just forgot it …

Dear Sir
if possible, please open my file, see below in my code;

Set rng_dest = Sheets("DC Record").Range("E:G")
' Find first empty row in columns E:G on sheet DC Record
Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
i = i + 1
Loop
'Copy range C13:I23 on sheet DC to Variant array
Set rng = Sheets("DC").Range("C13:I23")
' Copy rows containing values to sheet DC Record
For a = 1 To rng.Rows.Count
If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
rng_dest.Rows(i).Value = rng.Rows(a).Value

Marc L · Nov 5, 2019

See tips in my previous post, try the same on a new test worksheet but without any merged cells, that's the issue !

As in your mind you copy 3 columns but in fact C:I means 7 columns so 'cause of merged cells you can't copy entire row

but only needed columns like C alone (as merged) and H:I so two codelines are necessary …

Ateeb Ali · Nov 5, 2019

Dear Sir
Can you help me writing two code lines?

Marc L · Nov 5, 2019

As a beginner reminder : the easy way to go is without any merged cells ! (only 2 necessary codelines to copy all data …)

A For … Next loop is useless as you can directly copy all the data range at once …

According to your attachment an example for data in cell C : rng_dest.Rows(i).columns("E").Value2 = rng.Rows(a).Columns("C").Value2 …

Ateeb Ali · Nov 6, 2019

Dear Sir
I am really a beginner, i would appreciate if you can give me complete code as it is easy for you

vletm · Nov 6, 2019

Ateeb Ali
You asked 'complete code'
... if someone just would write it, then You will ask same with next Your thread.
You would try to learn...
Check Your code line-by-line and same time follow what do it do?
Do Your code do as You would like it work?
Is there needed steps?

Ateeb Ali · Nov 6, 2019

Noted dear thanks, its done

Revise code after unmerge cell

Code:

Sub Save_Data()
Dim rng As Range
  Dim i As Long
  Dim a As Long
  Dim rng_dest As Range
  Application.ScreenUpdating = False
  i = 1
  Set rng_dest = Sheets("DC Record").Range("E:G")
  ' Find first empty row in columns E:G on sheet DC Record
  Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
  Loop
  'Copy range C13:E23 on sheet DC to Variant array
  Set rng = Sheets("DC").Range("C13:E23")
    ' Copy rows containing values to sheet DC Record
  For a = 1 To rng.Rows.Count
    If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
      rng_dest.Rows(i).Value = rng.Rows(a).Value
      'Copy DC number
      Sheets("DC Record").Range("A" & i).Value = Sheets("DC").Range("E5").Value
      'Copy Date
      Sheets("DC Record").Range("B" & i).Value = Sheets("DC").Range("C5").Value
      'Copy Customer
      Sheets("DC Record").Range("C" & i).Value = Sheets("DC").Range("C7").Value
      'Copy P.O number
      Sheets("DC Record").Range("D" & i).Value = Sheets("DC").Range("E7").Value
      
    i = i + 1
    End If
  Next a
  Application.ScreenUpdating = True

End Sub

vletm · Nov 6, 2019

Ateeb Ali
Sorry that I wrote many lines.
Seems that You maybe read those, but that other part seems still missed.
Did You also checked that Your code could do those steps which You would like it to do? ... ... ... no.
Have You tried to do this with paper and pencil ... or manually?
Ps For me, unmerge or merged cells - no matter, if won't use those ranges as those are.

Ateeb Ali · Nov 6, 2019

Dear Sir
File attached, its working fine
not paper and pencil

Marc L · Nov 6, 2019

Ateeb Ali said:
I am really a beginner, i would appreciate if you can give me complete code as it is easy for you

As you wrote « your code » I let you to amend the source & destination columns, a child level difficulty …

According to your last attachment 'your' Save_Data procedure revamped :

Code:

    Dim L&, R&
    L = [B12].CurrentRegion.Columns(2).Find("*", , xlValues, , , xlPrevious).Row - 12:  If L < 1 Then Beep: Exit Sub
    R = Sheet4.Cells(Rows.Count, 1).End(xlUp)(2).Row
    Sheet4.Cells(R, 1).Resize(L, 4).Value2 = Array([E5], [C5], [C7], [E7])
    Sheet4.Cells(R, 5).Resize(L, 3).Value2 = [C13:E13].Resize(L).Value2

Do you like it ? So thanks to click on bottom right Like !

Ateeb Ali · Nov 6, 2019

Really appreciate very good code, can you add this that if DC#, PO#, Date, and Item description are same then not to copy data as it create duplication, is it possible through VB?

Marc L · Nov 6, 2019

So you dont't Like the code … As respecting results in your attachments, it reproduces the same than your procedure ‼

It's not a good idea on Excel side to leave some columns blank / empty.

Anyway if I well copy, just amend the codeline by deleting L in the Resize statement …

Ateeb Ali · Nov 6, 2019

Sir I like the code and it worked fine, thank you so much
Just I have added if there is a way to avoid duplication

Marc L · Nov 6, 2019

So you do not ever Like the code, read post #14 under the code …

On Excel side it's not a duplication - could be a mess without - and if I well catched I gave you in my previous post how to …

Ateeb Ali · Nov 7, 2019

Anyway if I well copy, just amend the codeline by deleting L in the Resize statement …
Sir
When removing L, it is just copying the first line of table and not the others
Following code is perfect

Code:

 Dim L&, R&
    L = [B12].CurrentRegion.Columns(2).Find("*", , xlValues, , , xlPrevious).Row - 12:  If L < 1 Then Beep: Exit Sub
    R = Sheet4.Cells(Rows.Count, 1).End(xlUp)(2).Row
    Sheet4.Cells(R, 1).Resize(L, 4).Value2 = Array([E5], [C5], [C7], [E7])
    Sheet4.Cells(R, 5).Resize(L, 3).Value2 = [C13:E13].Resize(L).Value2

Is it just possible that when these fields are identical and already available in DC record, its gives an alert of duplicate entry and restrict user for duplicate entry? (E5, C5, C7, E7, C13:E23) If this record already available in sheet "DC Record"

Marc L · Nov 7, 2019

As it's easier with an expecting result workbook or just with a targeted accurate explanation …

Next event code raises when a cell changes in C13:E23 if any empty cell within the row,

you must paste it to the Sheet3 (DC) worksheet module : (Edit v3)

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
      Const C = 4, D = "¤"
        Dim T$, Rg As Range, A$, S$, V
        If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect([C13:E23], Target) Is Nothing Then
            T = Replace("C¤:E¤", D, Target.Row):  If Application.CountBlank(Range(T)) Then Exit Sub
        With Sheet4.[A1].CurrentRegion.Rows
               Set Rg = .Columns(C).Find([E7].Value2, , xlValues, xlWhole)
            If Not Rg Is Nothing Then
               A = Rg.Address
               S = Join(Array([E5], [C5], [C7], [E7]), D) & D & Join(Application.Index(Range(T).Value2, 1, [{1,2,3}]), D)
               V = [COLUMN(A:G)]
             Do
                If S = Join(Application.Index(.Item(Rg.Row).Value, 1, V), D) Then
                    Range("C5,E5,C7,E7," & T).Select
                    Target.Activate
                    MsgBox "This row already exists in " & .Parent.Name & " #" & Rg.Row, vbExclamation, " Invalid row entry"
                    Target.Select
                    Application.EnableEvents = False
                    Target.ClearContents
                    Application.EnableEvents = True
                    Exit Do
                End If
                    Set Rg = .Columns(C).FindNext(Rg)
             Loop Until Rg.Address = A
                    Set Rg = Nothing
            End If
        End With
    End If
End Sub

You may Like it !

Ateeb Ali · Nov 8, 2019

Amazing amazing amazing
you are really excel ninja / excel tiger

Ateeb Ali · Nov 8, 2019

Sorry I am writing again, your solution worked perfect when we are typing same detail in sheet 3
I have attached updated sheet, what I want that when we press button save record and if record already exist in Sheet4 (DC Record), its gives that error that record already save.

Marc L · Nov 8, 2019

Ateeb Ali said:
its gives that error that record already save

Elaborate : what should exactly happen ?

Ateeb Ali · Nov 9, 2019

i mean it should restrict user when data already exist in sheet 3
the pop up error should say "data already exist"

Marc L · Nov 9, 2019

Code:

Private Sub Save_Data()
  Const D = "&""¤""&", F = "TRANSPOSE(E5,C5,C7,E7,C§:C#,D§:D#,E§:E#)", H = 12
    Dim L%, V, Z%
        L = [C24].End(xlUp).Row:  If L <= H Then Beep: Exit Sub
  With Sheet4.Cells(Rows.Count, 1).End(xlUp)
    If .Row > 1 Then
        V = Application.Match(Evaluate(Replace(Replace(Replace(F, "#", L), "§", H + 1), ",", D)), _
           .Parent.Evaluate(Replace(Replace("A2:A#,B2:B#,C2:C#,D2:D#,E2:E#,F2:F#,G2:G#", "#", .Row), ",", D)), 0)
        For Z = 1 To L - H:  V(Z) = IIf(IsError(V(Z)), False, H + Z):  Next
        V = Join(Filter(V, False, False), ", ")
        If V > "" Then MsgBox "Data already saved in" & vbLf & vbLf & "row #" & V, vbExclamation, " Operation Aborted": Exit Sub
    End If
       .Offset(1).Resize(L - H, 4).Value2 = Array([E5], [C5], [C7], [E7])
       .Offset(1, 4).Resize(L - H, 3).Value2 = Cells(H + 1, 3).Resize(L - H, 3).Value2
  End With
End Sub

You should Like it !

VB Code to copy data from one sheet to another sheet

Member

Attachments

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Attachments

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Member

Attachments

Excel Ninja

Member

Excel Ninja