• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VB Code to copy data from one sheet to another sheet

Dear Champ
I need your help again, I write following code to copy date (now invoice) from one sheet to another, need help to write me code as you previously help.

My code
Code:
Sub Save_Data2()
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("Invoice data").Range("F:H")
  ' Find first empty row in columns F:H on sheet Invoice data
  Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
  Loop
  'Copy range A17:C33 on sheet Invoice to Variant array
  Set rng = Sheets("Invoice").Range("A17:C33")
  ' Copy rows containing values to sheet Invoice data
  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 Invoice number
      Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("D4").Value
      'Copy Date
      Sheets("Invoice data").Range("B" & i).Value = Sheets("Invoice").Range("D3").Value
      'Copy Company name
      Sheets("Invoice data").Range("C" & i).Value = Sheets("Invoice").Range("D5").Value
      'Copy P.O number
      Sheets("Invoice data").Range("D" & i).Value = Sheets("Invoice").Range("D6").Value
      'Copy DC number
      Sheets("Invoice data").Range("E" & i).Value = Sheets("Invoice").Range("D7").Value
      i = i + 1
    End If
  Next a
  Application.ScreenUpdating = True

End Sub

I need code as below which you helped me previously

Code:
Sub Save_Data1()
  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

This time when field "Sheet Invoice D5, D6, D7, A17:C33" if already exist in Sheet "Invoice Data" it work same way as you do for DC (File also enclosed)

Next thing I want to ask, is it possible if we press new button, it should check "data sheets (For DC, Data sheet is Dc Record, for Invoice, Data Sheet is Invoice Data)" if record not save there, it should say, "record not save, you want to continue"
 

Attachments

  • DC TO Invoice.xlsb
    73.9 KB · Views: 6
Yes sir, Bill# date and other column does not matter
As I want once bill generated against one particular PO and DC, it should not be generated again
 
when field "Sheet Invoice D5, D6, D7, A17:C33" if already exist in Sheet "Invoice Data"
Code:
Sub Save_Data2()
  Const D = "&""¤""&", F = "TRANSPOSE(D5,D6,D7,A§:A#,B§:B#,C§:C#)", H = 16
    Dim L%, V, Z%
        L = [A15:A33].Find("*", , xlValues, , , xlPrevious).Row:  If L <= H Then Beep: Exit Sub
  With Sheet2.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("C2:C#,D2:D#,E2:E#,F2:F#,G2:G#,H2:H#", "#", .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, 5).Value2 = Array([D4], [D3], [D5], [D6], [D7])
       .Offset(1, 5).Resize(L - H, 3).Value2 = Cells(H + 1, 1).Resize(L - H, 3).Value2
  End With
End Sub
You could Like it !
 
Dear Sir, thank you so much, worked perfectly.
Is there is a way, if user dont click save data button mistakenly and press "Next/New" button, it should say user that data not save, you sure want to proceed, there is option yes or no
is it possible?
 
Yes but instead of a next / new button what about clearing cells when saving data ? …​
If really this button is necessary, ok pour DC but for Invoice you must elaborate exactly what should be done​
as per the actual code clears all the formulas !​
 
yes you are right actual code currently was a mistake, I have now wrote a new code and liked your idea about clearing cell when saving data, will check it

Current code for new / next on invoice sheet;
Code:
Sub New_Invoice()

Range("D4").Value = Range("D4").Value + 1
Range("D5:D6").ClearContents
Range("C16:C33").ClearContents


End Sub
PLEASE see attached update file
SaveData2 was working fine but I just write a formula against which now it show only those DC's quantity which invoice not generated before but as soon as we press save data, it first copying the header due to which main source data formula become zero, can you fix it please

Code should first paste values in Invoice Data along with Header, need help again please
 

Attachments

  • DC TO Invoice.xlsb
    90.5 KB · Views: 14
Difficult to follow, you need to well explain, elaborate …​
The reason why before creating any thread the context must be 'fixed' and must not change after,​
the reason why Excel is very not the way to go for any database project …​

but I just write a formula
Which one, where ?!​
 
I wrote a formula in Sheet4 (DC Record), according to that formula once invoice generated against DC, the record will be blank.

If Invoice not generated, the record is available for Invoice generation.

On Sheet1 (Invoice), I have mentioned a formula which is automatically picking value from Sheet4 for only those DCs which Invoice not yet generated.

So when code SavaData2 saving invoice data (Sheet2), the formula in Sheet1 (Invoice) disappears which naturally it should be.

So SaveData2 should paste value top and bottom at once for example (Sheet1 cells: D2:D9 & A17:C33) should be copied and paste together
 
According to your post #31 Save_Data2 well works but if necessary you can amend both Offset Copy codelines for your new context …​
 
thanks its resolved, i have amend code as below;
Code:
Sub Save_Data2()
    Application.Calculation = xlManual
  Const D = "&""¤""&", F = "TRANSPOSE(D5,D6,D7,A§:A#,B§:B#,C§:C#)", H = 16
    Dim L%, V, Z%
        L = [A15:A33].Find("*", , xlValues, , , xlPrevious).Row:  If L <= H Then Beep: Exit Sub
  With Sheet2.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("C2:C#,D2:D#,E2:E#,F2:F#,G2:G#,H2:H#", "#", .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, 5).Value2 = Array([D4], [D3], [D5], [D6], [D7])
       .Offset(1, 5).Resize(L - H, 3).Value2 = Cells(H + 1, 1).Resize(L - H, 3).Value2
  End With
    Application.Calculation = xlAutomatic
Range("D4").Value = Range("D4").Value + 1
Range("D5:D6").ClearContents
Range("C16:C33").ClearContents
ActiveWorkbook.Save

End Sub
 
Dear Marc L (Excel Ninja)
I am sorry to write you again, the code working fine but slowing the file and taking time, can you just help me removing the condition like we put before that its checking another sheet if data available there, now I just wanted to add data in blank cells, thats all
Code:
Sub Save_Data2()
    Application.Calculation = xlManual
  Const D = "&""¤""&", F = "TRANSPOSE(D5,D6,D7,A§:A#,B§:B#,C§:C#)", H = 16
    Dim L%, V, Z%
        L = [A15:A33].Find("*", , xlValues, , , xlPrevious).Row:  If L <= H Then Beep: Exit Sub
  With Sheet2.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("C2:C#,D2:D#,E2:E#,F2:F#,G2:G#,H2:H#", "#", .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, 5).Value2 = Array([D4], [D3], [D5], [D6], [D7])
       .Offset(1, 5).Resize(L - H, 3).Value2 = Cells(H + 1, 1).Resize(L - H, 3).Value2
  End With
    Application.Calculation = xlAutomatic
Range("D4").Value = Range("D4").Value + 1
Range("D5:D6").ClearContents
Range("C16:C33").ClearContents
ActiveWorkbook.Save

End Sub
 
It's often the issue with the bad idea of using Excel as a database software …​
The post #30 code revamped :​
Code:
Sub Save_Data2r()
  Const H = 16
    Dim L%
        L = [A15:A33].Find("*", , xlValues, , , xlPrevious).Row:  If L <= H Then Beep: Exit Sub
    With Sheet2.Cells(Rows.Count, 1).End(xlUp)
        .Offset(1).Resize(L - H, 5).Value2 = Array([D4], [D3], [D5], [D6], [D7])
        .Offset(1, 5).Resize(L - H, 3).Value2 = Cells(H + 1, 1).Resize(L - H, 3).Value2
    End With
End Sub
 
Back
Top