Copying data with same headers from sheet 2 to sheet 1. VBA???

[jacobswayne]

Hello everyone. I have had this issue for about a week now and it has been killing me slowly. What I am trying to do is move data from “sheet 2” to “sheet 1”. I only need the values to move over from sheet2 to sheet1 (the headers are the same). For example, on both sheets lets say I have name,address, POC info. Sheet 1 has name and address info, sheet 2 has POC info. I need to move the POC info to sheet 1. When I say poc info its separated by different columns like name, email, phone number,etc. Can someone assist? Does this make sense?? Ive been copying and pasting and its taking me foreverrrrrrrr.

Ive tried vlookup and im not good with vba so neither worked for me. Safe to say im a noob :/


Thank you.

 

[gallen]

My thinking was to write VBA code to do the search. If there's a chance the name repeats it is possible to being through incorrect info. Is it possible? How many records are there? You could always search for duplicates first off.

 

[gallen]

Out of interest is the data setup in an excel table (listobject). If this question is confusing then I'd guess at "no"

 

[gallen]

This code is a start. It checks sheet 2 for the name in sheet 2. If found it copies any details over that aren't in sheet 1

Paste the code in sheet1's code module (although it will work from any module.)

Ensure to test on copy of your data. I've tested with minimal data and no duplicates

Option Explicit


'Enum assumes columns start in column A
Public Enum ColumnHeaders
    ID = 1
    FullName
    StreetAddress
    City
    State
    ZipCode
    Country
    ITName
    ITTitle
    ITEmail
    ITPhone
    ITName1
    ITTitle1
    ITEmail1
    ITPhone1
    Website
End Enum

Sub CollaborateDetails()
    'this assumes the columns start in column A
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lr As Long 'last row of data in sheets
    Dim l As Long 'loop counter
    Dim i As Integer 'loop counter
    Dim rSearchRange As Range 'list of names on sheet 2
    Dim rFind As Range 'used in the search
    
    Set ws1 = Sheets("Sheet1"): Set ws2 = Sheets("Sheet2")
    
    'last row on sheet 2
    lr = ws2.Cells(ws2.Rows.Count, FullName).End(xlUp).Row
    
    'get the data range of the names column
    Set rSearchRange = ws2.Range(ws2.Cells(2, FullName), ws2.Cells(lr, FullName))
    
    'now get last row of sheet 1
    lr = ws1.Cells(ws1.Rows.Count, FullName).End(xlUp).Row
    
    'assuming data starts at row 2 loop through all names
    For l = 2 To lr
        'search for name value in sheet1 in the name range
        Set rFind = rSearchRange.Find(ws1.Range("B" & l))
        
        If Not rFind Is Nothing Then
            'Name found so collaborate details
            ' Loop through each cell in the current row of Sheet1 and if it's blank, check if the corresponding cell on sheet2 has any info
            'Only check the 'City' column onwards
            For i = City To Website
                If ws1.Cells(l, i) = "" Then 'Are the details in the column empty?
                    'Check for any value in sheet2 and copy it over to sheet1
                    ws1.Cells(l, i) = ws2.Cells(rFind.Row, i)
                End If
            Next i
        End If
    Next l
        
End Sub

 

[jacobswayne]

I get an error on:

Set rFind = rSearchRange.Find(ws1.Range("B" & l))

 

[jacobswayne]

and to answer your question I dont believe it is setup with listobject

 

[gallen]

I get an error on:

Set rFind = rSearchRange.Find(ws1.Range("B" & l))

What error message are you getting?

 

[jacobswayne]

What error message are you getting?

Runtime error 13
type mismatch

 

[jacobswayne]

What error message are you getting?

Any idea?

 

[jacobswayne]

What error message are you getting?

Actually give me a sec it mightve worked.

 

[jacobswayne]

I think it worked but the fields are out of place. For example the poc data like email is under the poc phone number or vice versa.