Macro to copy data from one worksheet to another

[khelza]

Hey guys,

So I currently have a macro button that, when pressed, imports an entire table into sheet11 from a mySQL database.

In the same workbook, I have an excel sheet1, that has many of the same columns as the new table in sheet11. I would like to get it where when the macro button is pressed, it still pulls the whole table into sheet11, but then copies rows from sheet11, into sheet1 if the ID matches (found in column A of both sheets).

It would be nice to get it where it matches CW_ID (Sheet11:A) with CW_ID (Sheet1:A), then..
Description(Sheet11:B) get filled into Description (Sheet1:M)
Manufacturer(Sheet11:C) get filled into Manufacturer (Sheet1:O)
Model Number (Sheet11:D) get filled into Manufacturer (Sheet1:P)
etc..

sheet11:

Sheet1:

I have looked at so many examples on the web, but none that work for me.

What I have so far:

Private Sub CommandButton21_Click()

' Create a recordset object.
Dim rsMaterialsdb As ADODB.Recordset
Dim Lcw_ID As String
Dim LRow As Integer
Dim LFound As Boolean
Set rsMaterialsdb = New ADODB.Recordset


'connect to your mysql server
ADOExcelSQLServer


With rsMaterialsdb
    ' Assign the Connection object.
    .ActiveConnection = cn
    ' Extract the required records.
    .Open "SELECT m.CW_id,m.Description,ma.Manufacturer, m.Model_Number, pv.vendor AS Primary_Vendor, av.vendor AS Alternate_Vendor,m.Cost_CND FROM materials m INNER JOIN manufacturers ma ON m.Manufacturer=ma.Manuf_ID INNER JOIN vendors pv ON pv.Vendor_ID=m.primary_vendor INNER JOIN vendors av ON av.Vendor_ID=m.alternate_vendor ORDER BY m.CW_ID"
    ' Copy the records into cell O6 on Sheet1.
    Sheet11.Range("A2").CopyFromRecordset rsMaterialsdb
    
    ' Tidy up
    .Close
End With


cn.Close    'close connect to db

'*The above code works: pulls table from mySQL into sheet11. The following code is supposed to match ID's in column A of both sheets, and copy data to sheet1


'Retrieve cw_ID value to search for
Lcw_ID = Sheet11.Range("A2").Value
   
Sheet1.Select
   
'Start at Row 2 (Headers are on row 1, data starts at 2)
LRow = 2
LFound = False
   
   While LFound = False
   
      'Encountered blank cell in column A, terminate search
      If Len(Cells(LRow, 1)) = 0 Then
         MsgBox "No matching cw_ID was found."
         Exit Sub
         
      'Found match in row 1
      ElseIf Cells(LRow, 1) = Lcw_ID Then
      
         'Select values to copy from sheet11
         Sheet11.Select
         Range("B2:G55").Select  'Not sure how to use a variable range, this line gives me errors anyways
         Selection.Copy
         
         'Paste onto sheet1
         Sheet1.Select
         Cells(2, 13).Select     'again, not sure how to make this a variable range
         Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
         False, Transpose:=False
         
         LFound = True
         MsgBox "The data has been successfully copied."
         
      'Continue searching
      Else
         LRow = LRow + 1
      End If
      
   Wend
                
End Sub

Any help would be greatly appreciated!

 

[mumps]

This macro should do the data copying for you. I am assuming that there are no duplicate ID's.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet11").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim ID As Range
    Dim foundID As Range
    For Each ID In Sheets("Sheet11").Range("A2:A" & LastRow)
        Set foundID = Sheets("Sheet1").Range("A:A").Find(ID, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundID Is Nothing Then
            Sheets("Sheet1").Range("M" & foundID.Row) = Sheets("Sheet11").Range("B" & ID.Row)
            Sheets("Sheet1").Range("O" & foundID.Row) = Sheets("Sheet11").Range("C" & ID.Row)
            Sheets("Sheet1").Range("P" & foundID.Row) = Sheets("Sheet11").Range("D" & ID.Row)
        End If
    Next ID
    Application.ScreenUpdating = True
End Sub

 

[khelza]

@mumps, thanks for your help!

I get an error at line

[COLOR=#333333]LastRow = Sheets("Sheet11").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row[/COLOR]

 

[khelza]

Something worth mentioning, sheet11 has each part listed once, with cw_ID's in order. Therefore, column A will have all unique entries.

However, sheet1 has many parts listed several times throughout the table. Therefore, column A will not have all unique entries as some are purposely duplicated.

 

[khelza]

The error on the line I showed was because Sheet1 and 11 are actually named something, so I just had to change the names, but thanks this code seems to work! Although it's filling in MOST of the data, but not all of it for some reason. Seems to be any of the ones that are repeated in Sheet1 are not getting populated.

 

[mumps]

Are your sheets named "Sheet11" and "Sheet1" or do they have different names? In terms of the duplicates in Sheet1, column A, does this mean that you want the B, C and D columns from Sheet1 to be copied to each occurrence of the ID number in Sheet1?

 

[khelza]

Yes, the sheets are named differently, which I have now fixed (see previous post)

I'm hoping to have all ID's populated in sheet1, even duplicates.

Example:

Sheet1
CW_ID (A) | Description (M) | Manufacturer (O) | Model Number (P) | Pri Vendor (Q) | Alt Vendor (R) | Cost (S) |
--------------------------------------------------------------------------------------------------------------------------------
1141____| _____Sheet11.B | ______Sheet11.C |_______ Sheet11.D |____Sheet11.E |____Sheet11.F | Sheet11.G
1818____ | _____Sheet11.B | ______Sheet11.C |_______ Sheet11.D |____Sheet11.E |____Sheet11.F | Sheet11.G
1001____ | _____Sheet11.B | ______Sheet11.C |_______ Sheet11.D |____Sheet11.E |____Sheet11.F | Sheet11.G
1141____| _____Sheet11.B | ______Sheet11.C |_______ Sheet11.D |____Sheet11.E |____Sheet11.F | Sheet11.G
1566____ | _____Sheet11.B | ______Sheet11.C |_______ Sheet11.D |____Sheet11.E |____Sheet11.F | Sheet11.G

 

[mumps]

If you want to populate duplicate occurrences of ID's in Sheet1, columns M, O and P , it would simply populate each duplicate ID with the same data from Sheet11. Is that what you want?

 

[khelza]

That is what I want, however, the code you supplied seems to only be populating the first instances that the ID's appear (duplicates are ignored, left blank) in sheet1

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet11").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim ID As Range
    Dim sAddr As String
    Dim foundID As Range
    For Each ID In Sheets("Sheet11").Range("A2:A" & LastRow)
        With Sheets("Sheet1").Range("A:A")
            Set foundID = .Find(ID, LookIn:=xlValues, lookat:=xlWhole)
            If Not foundID Is Nothing Then
                sAddr = foundID.Address
                Do
                    Sheets("Sheet1").Range("M" & foundID.Row) = Sheets("Sheet11").Range("B" & ID.Row)
                    Sheets("Sheet1").Range("O" & foundID.Row) = Sheets("Sheet11").Range("C" & ID.Row)
                    Sheets("Sheet1").Range("P" & foundID.Row) = Sheets("Sheet11").Range("D" & ID.Row)
                    Sheets("Sheet1").Range("Q" & foundID.Row) = Sheets("Sheet11").Range("E" & ID.Row)
                    Sheets("Sheet1").Range("R" & foundID.Row) = Sheets("Sheet11").Range("F" & ID.Row)
                    Sheets("Sheet1").Range("S" & foundID.Row) = Sheets("Sheet11").Range("G" & ID.Row)
                    Set foundID = .FindNext(foundID)
                Loop While foundID.Address <> sAddr
                sAddr = ""
            End If
        End With
        Set foundID = Nothing
    Next ID
    Application.ScreenUpdating = True
End Sub

Change the sheet names accordingly.