moving data

KATHYSPEERS

Board Regular
Joined
Dec 17, 2007
Messages
100
I am trying to move the following data

Column A Column B

1023459 pricing 1
1023459 pricing 2 - this cell I would like to move to column C and thus removing the duplicate from column A- so that I can use the lookup function for another workbook - thanks for your help
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Are you stating that you want to transform your example from two rows to one row where pricing c would end up in column c?

Column A Column B
1023459 pricing 1
1023459 pricing 2



to

Column A Column B Column c
1023459 pricing 1 pricing 2
 
Upvote 0
The following code assumes you data is in "Sheet1" and will transform it as you describe. Rather than modifing Sheet1" the resulting data will be place on "Sheet2".

Code:
Option Explicit
Type RecType
    PartNo As String
    Price() As String
End Type
Sub ElimateDups()
    Dim WksDest As Worksheet
    
    Dim RowNo As Long
    Dim ColNo As Long
    
    Dim rngSrc As Range
    Dim rec() As RecType
    Dim Idx As Long
    Dim J As Integer
    
    ReDim rec(0)
    ReDim rec(0).Price(0)
    
    Set rngSrc = ThisWorkbook.Worksheets("Sheet1").UsedRange
    Set WksDest = ThisWorkbook.Worksheets("Sheet2")
    
    WksDest.Cells.ClearContents
    
    RowNo = 2
    
    Do While RowNo <= rngSrc.Rows.Count
        Debug.Print rngSrc.Cells(RowNo, 1)
        Idx = InsertRec(Trim(rngSrc.Cells(RowNo, 1)), Trim(rngSrc.Cells(RowNo, 2)), rec)
        RowNo = RowNo + 1
    
'        'Now Export the data to a second workshhet
        For Idx = 1 To UBound(rec)
            WksDest.Cells(Idx, 1) = rec(Idx).PartNo
            For J = 0 To UBound(rec(Idx).Price)
                WksDest.Cells(Idx, 2 + J) = rec(Idx).Price(J)
            Next J
        Next Idx
    
    Loop
End Sub
Function InsertRec(ByVal PartNo As String, ByVal Price As String, rec() As RecType) As Long
    Dim Idx As Long
    
    Dim intUB As Integer
    
    For Idx = 0 To UBound(rec)
        If rec(Idx).PartNo = PartNo Then
            Exit For
        End If
    Next Idx
    If Idx > UBound(rec) Then
        ReDim Preserve rec(Idx)
        rec(Idx).PartNo = PartNo
        ReDim rec(Idx).Price(0)
        rec(Idx).Price(0) = Price
    Else
        intUB = UBound(rec(Idx).Price) + 1
        ReDim Preserve rec(Idx).Price(intUB)
        rec(Idx).Price(intUB) = Price
    End If
End Function

The code can handle more than one duplicates. If there are three occurances or the item in column "A", the thrid prices will appear in "D"
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,857
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top