Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

pull archive data from sheet to another

0

hi experts 

first  of  all  this  file   not  mine   when  I searched   in  the  internet   I've  found it   and   the  code I  got   from another   forum   , I 've   found    this  is soon from  my  post   so    I   have  no experience  about  vba   I  can mod  some  codes   sometimes    it  works  and  often  I  failed    , indeed  I ameded this  code  but  doesn't  work well   I  put  the  expected  result  in  sheet "invoice"  based  on  cell value   e5   or   e8    if   I  write  in  e5   then  pull data   in e8  and  g5    and   the  rests  of  data  from    row  16     the  same  thing  when  write in  e8   bit  should  happen  with  the  rests of  cells   , if  any  body  help  mod  the  code  or   write  another  macro  I  truly appreciate  that  

Sub CopyData()

    Dim Cl As Range
    Dim SrcSht As Worksheet
    Dim DestSht As Worksheet
    Dim Rng As Range

Application.ScreenUpdating = False

    Set SrcSht = Sheets("data")
    Set DestSht = Sheets("invoice")

    With CreateObject("scripting.dictionary")
        For Each Cl In DestSht.Range("e5", DestSht.Range("e" & Rows.Count).End(xlUp))
            If Not .exists(Cl.Value) Then .Add Cl.Value, Nothing
        Next Cl
        For Each Cl In SrcSht.Range("b2", SrcSht.Range("b" & Rows.Count).End(xlUp))
           If Not .exists(Cl.Value) or Cl.Offset(, 1).Value <> "" Then
           ' Not .exists(Cl.Value) Then
                If Rng Is Nothing Then
                    Set Rng = Cl
                Else
                    Set Rng = Union(Rng, Cl)
                End If
            End If
        Next Cl
    End With
    Rng.EntireRow.Copy DestSht.Range("A" & Rows.Count).End(xlUp).Offset(1)

End Sub
Answer
Discuss

Discussion

Speed
I don't have time to look at your workbook today but others may answer before me.
Suggest you need to fix on part of your macro: either delete the line Application.ScreenUpdating = False (for speed) OR add:    
Application.ScreenUpdating = True
before End Sub
John_Ru (rep: 6102) Jan 14, '21 at 4:02 pm
Speed. Please repeat (in your question) the additional comments you made yesterday about how you want the sheet to work (I can't see that post now the associated Answer has been deleted) 
John_Ru (rep: 6102) Jan 16, '21 at 5:18 am
ok  let's strat  again   when  i   write   the  value  in cells e5  in sheet "invoice"    if   mathced  with  values  in  column  b   in sheet  "data"   then  copy  the  date  to  cell  g5   and   customer   in  e8    and   the  rests  of  data   from  row 16    in sheet " invoice "   as  what  i  put  the  result   in  attached file    it  should  automatically  by  worksheet  change  event
speed (rep: 40) Jan 16, '21 at 4:43 pm
Add to Discussion

Answers

0
Selected Answer

Speed

Further to your "start again" point (in the discussion under the question), the attached file will automatically update the invoice if E5 in INVOICE is changed to a value found in the DATA sheet (via the Worksheet_Change event, as requested).

The first line of the code means nothing happens unless E5 has been changed (or you pressed Enter from that cell). I've then commented the other lines so you can follow what the macro does in the loop.

REVISION 1: Code/file changed so a new (unknown) entry in E5 leaves a blank invoice.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("E5")) Is Nothing Then Exit Sub
Dim Firstfind As Boolean, rw As Integer

Target.Offset(3, 0).ClearContents 'clear Date
Target.Offset(0, 2).ClearContents  'clear Customer ID
Range("A16:H30").ClearContents ' clear invoice items

With Sheets("DATA")

    For rw = 2 To .Cells(Rows.Count, 2).End(xlUp).Row 'go fom 2 to the last used row in column 2
        If Target.Value = .Cells(rw, 2) Then 'check for a match

            If Firstfind = False Then 'if the value is found for the first time only
                Firstfind = True ' make sure this bit isn't done again
                Target.Offset(3, 0) = .Cells(rw, 3) 'copy Date
                Target.Offset(0, 2) = .Cells(rw, 1) 'copy Customer ID
            End If

        c = c + 1 'update the counter
        .Range("C" & rw & ":I" & rw).Copy   ' copy from columns C to H in DATA
        Sheets("INVOICE").Range("A" & 15 + c).PasteSpecial Paste:=xlPasteValues 'PasteSpecial Values only into INVOICE
        Application.CutCopyMode = False 'remove "marching ants" around copied area
        End If
    Next rw

End With
' say if invoice was changed
If c > 0 Then
    MsgBox "Added data for Invoice # " & Target.Value
    Else
    MsgBox "Invoice number " & Target.Value & " not found on DATA sheet, values cleared"
End If
End Sub

Note that I tidied up the INVOICE tab a bit (e.g. moved subtotal, tax and total to column G and cleared columns H to J).

Hope this helps

Discuss

Discussion

great  work  !   absolutely   this  is  what  i was  looking  for   , but  i  have  notice  about  this   line 
                Range("A16:H30").ClearContents ' clear invoice items NOTE no leading dot (so in INVOICE)


 as I  understand  it  , it  should  clear  the range if  the  invoice  is  not  existed  then clear  the  range  after showing  message , but   it  doesn't  happened  , otherwise  every  thing  is  ok 
speed (rep: 40) Jan 17, '21 at 2:34 pm
Thanks Speed
.
If E5 is changed (or entered) and the macro finds a first match in DATA , that line clears the INVOICE range A16:H30 before it imports cell values from DATA. 

If you keep the same value in E5 but re-enter E5 (or enter another known value from DATA), it will import the same data so it will look like nothing happened. Write some data in other cells elsewhere in A16:H30 then re-enter E5 and you willl see the cells not related to the found DATA will be cleared.

If you want an unknown number in E5 to clear the invoice then change the last few lines of the sub to read:
If c > 0 Then
    MsgBox "Added data for Invoice # " & Target.Value
    Else
    Target.Offset(3, 0).ClearContents 'clear customer ID
    Target.Offset(0, 2).ClearContents  ''clear customer ID
    Range("A16:H30").ClearContents ' clear invoice items
    MsgBox "Invoice # " & Target.Value & " not found on DATA sheet, values cleared"
End If
End Sub

Also, I suggest you alter the heights of rows 16 to 30 in INVOICE since your earlier attempts at copying from DATA have made the first few quite different in height.
John_Ru (rep: 6102) Jan 17, '21 at 4:47 pm
you are  the  best   thanks    for   the  great   code 
best regards,
speed
speed (rep: 40) Jan 18, '21 at 3:33 am
Speed.
Cheers. Please see my revised Answer- I realised this morning that my suggestion gives a duplication of Range("A16:H30").ClearContents so I've moved the lines (suggested above) to the start of the working code and removed the duplication from the If Firstfind is False Then loop.
John_Ru (rep: 6102) Jan 18, '21 at 3:59 am
I  apprecite  your   efforts    thanks  again  for  every thing 
god  bless you 
speed (rep: 40) Jan 18, '21 at 4:20 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login