• 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

Status
Not open for further replies.
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: 8
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
 
Ateeb Ali said:
when field "Sheet Invoice D5, D6, D7, A17:C33" if already exist in Sheet "Invoice Data"
Click to expand...
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 …​

Ateeb Ali said:
but I just write a formula
Click to expand...
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
 
@Marc L need your help same kind of format i was working this first part is working fine. Which is
>>> use code - tags <<<
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 History").Range("E:J")
 ' Find first empty row in columns E:j on sheet Invoice Hsitory
  Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
  Loop
  'Copy range B10:G24 on sheet APQ to Variant array
  Set rng = Sheets("APQ").Range("B10:G24")
 
  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 History").Range("B" & i).Value = Sheets("APQ").Range("E4").Value
      'Copy Date
      Sheets("Invoice History").Range("A" & i).Value = Sheets("APQ").Range("H6").Value
      'Copy Company name
      Sheets("Invoice History").Range("C" & i).Value = Sheets("APQ").Range("D7").Value
      'Copy P.O number
      Sheets("Invoice History").Range("D" & i).Value = Sheets("APQ").Range("C5").Value
      i = i + 1
End If
  Next a
  Application.ScreenUpdating = True
        End Sub


now I need the secod code for this because i dont want to copy same data two times??
 
Last edited by a moderator:

malikusmanali.awan​

As You've read from Forum Rules before Your the 1st post:
  • Start a new post every time you ask a question, even if the theme is similar. The original author may continue asking questions whilst the post is in progress and of course if you are answering questions you may need to ask questions of the initial poster.
Please, reread

Site Rules - New Users - Please Read

Hi all, Welcome to the Chandoo.org Forums. Posting Rules & Etiquette The Chandoo.org Forums is a collaborative and happy place to learn and expand your Excel knowledge. The Chandoo.org Forums consist of several Sub-Forums based on the type of question/area of Excel you are interested in...
chandoo.org
 
Status
Not open for further replies.
Back
Top