CODEWITHSUNDEEP
vbaexcel
H3katonkheir
H3katonkheir

Reputation: 663

Replacing excel data using another spreadsheet

I have two excel spreadsheets, one contains data on various persons, while the other is more of an index.

The 'Index' spreadsheet is laid out as following (as an example);

      A       B
1 [person:][pID: ]
2 [Mark   ][1    ]
3 [James  ][2    ]
4 [John   ][3    ]
5 [David  ][4    ]
n [ ...   ][n    ]

The 'Data' spreadsheet is laid out as following (as an example);

      A
1 [pID:   ][ ...
2 [David  ][ ...
3 [David  ][ ...
4 [David  ][ ...
5 [James  ][ ...
6 [Mark   ][ ...
7 [David  ][ ...
n [ ...   ][ ...

What I would like to do is replace the column A in the 'Data' spreadsheet, with the corresponding index of the 'Index' spreadsheet, probably using VBA.

The result would be something like this;

      A
1 [pID:   ][ ...
2 [4      ][ ...
3 [4      ][ ...
4 [4      ][ ...
5 [2      ][ ...
6 [1      ][ ...
7 [4      ][ ...
n [ ...   ][ ...

I have seen some static approaches which use a switch statement, but I'd really like to be able to import the data from another spreadsheet. I'm trying not to resort to copy pasting and 'Replace All'.

Thanks!

Upvotes: 1

Views: 3692

Answers (3)

Kittoes0124
Kittoes0124

Reputation: 5080

I don't believe VBA is the best solution to this issue. A simple VLOOKUP would accomplish exactly what you need to do.

=VLOOKUP(Data!$A1, Index!$A$2:$A$5, 1, FALSE)

Would give you the results that you're looking for.

Upvotes: 1

Reafidy
Reafidy

Reputation: 8441

Try this:

Sub HTH()

    With Sheets("Data")
        .Columns(2).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Cells(1, "B").Value = .Cells(1, "A").Value
        With .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Offset(, 1)
            .Formula = "=VLOOKUP(A2,Index!A:B,2,FALSE)"
            .Value = .Value
        End With
        .Columns(1).Delete
    End With

End Sub

Explanation:

Sub HTH()

    With Sheets("Data")
        '// Insert a new column with same format
        .Columns(2).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        '// Copy the header
        .Cells(1, "B").Value = .Cells(1, "A").Value
        '//  Work with the used range of column A 
        With .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Offset(, 1)
            '// Use a formula to replace the names with corresponding values
            .Formula = "=VLOOKUP(A2,Index!A:B,2,FALSE)"
            '// Replace formula with value
            .Value = .Value
        End With
        '//  Delete the old column
        .Columns(1).Delete
    End With

End Sub

NOTE:

Personally, I would leave the Raw data sheet as is and use a presentation sheet which looks up the data sheet and the index sheet and presents it how you want it. Then you wont necessarily need code and if you still do want to use code then the code will be much simpler. You will need to add code to turn off screen updating and use error handling etc.

An alternative to ja72's solution: 

Sub HTH()
    Dim vNames As Variant, vResult As Variant
    Dim lLoop As Long

    vNames = Sheets("Index").UsedRange.Columns(1).Resize(, 2).Value2
    vResult = Sheets("Data").UsedRange.Columns(1).Value2

    With CreateObject("Scripting.Dictionary")
        For lLoop = 2 To UBound(vNames, 1)
            .Add vNames(lLoop, 1), vNames(lLoop, 2)
        Next lLoop

        For lLoop = 2 To UBound(vResult, 1)
            vResult(lLoop, 1) = .Item(vResult(lLoop, 1))
        Next lLoop

        Sheets("Data").Range("A1").Resize(UBound(vResult, 1), 1).Value = vResult
    End With

End Sub

quietly confident its faster too ;)

Upvotes: 4

John Alexiou
John Alexiou

Reputation: 29254

Try this with VBA:

Public Sub FindPID()
    Dim i As Integer, N As Integer
    Dim r_index As Range
    ' Find start of index
    Set r_index = Sheets("Index").Range("A2")
    ' Count rows in index
    N = r_index.Worksheet.Range(r_index, r_index.End(xlDown)).Rows.Count
    ' Expand range with all values
    Set r_index = r_index.Resize(N, 2)
    Dim vals As Variant
    ' Move values into array
    vals = r_index.Value2
    ' Create a lookup collection
    Dim lup As New Collection
    For i = 1 To N
        ' Add each pID to collection with name as key
        lup.Add vals(i, 2), vals(i, 1)
    Next i

    Dim r_data As Range, M As Integer
    ' Find start of data
    Set r_data = Sheets("Data").Range("A2")
    ' Count rows in data
    M = r_data.Worksheet.Range(r_data, r_data.End(xlDown)).Rows.Count
    ' Expand range with all values
    Set r_data = r_data.Resize(M, 1)
    ' Move values into array
    vals = r_data.Value2
    For i = 1 To M
        ' Replace first column with lookup pID
        vals(i, 1) = lup(vals(i, 1))
    Next i
    ' Assign values from array back to cells.
    r_data.Value2 = vals
End Sub

This will work the fastest of all.

Upvotes: 1

Related Questions