Consulting

Results 1 to 5 of 5

Thread: Manipulate 2 different columns to become one

  1. #1

    Manipulate 2 different columns to become one

    Hi all,

    I would like to manipulate the columns of 2 different excel file to be the same. For example,

    In the first file, I have Apple Orange Mango Starfruit.

    In the second file, I have Orange, honeydew, dragonfruit.

    I would like to make both columns of both file the same, Apple Orange Mango starfruit honeydew dragonFruit, so that it will be possible to append the files together.

    Cheers,
    Jack

  2. #2
    Option Explicit 
     
     
    Sub test() 
        Dim r1 As Range 
        Dim r2 As Range 
         
        Set r1 = Sheets(1).Cells(1).CurrentRegion.Columns(1).Cells 
        Set r2 = Sheets(2).Cells(1).CurrentRegion.Columns(1).Cells 
         
        r1.Copy r2(r2.Count).Offset(1) 
        r2.EntireColumn.RemoveDuplicates 1 
        r2.EntireColumn.Copy r1(1) 
         
    End Sub 
    
    
    Formatting tags added by mark007

    マナ

  3. #3
    Give this a trial. Data in "A" in both files. Note the format of data has to maintained with a comma and space between words. HTH. Dave
    Sub tested() 
        Dim FilDir As Object, Lastrow As Integer, cnt As Integer, Wrd As Variant, fso As Object 
         'data in "A1:A" & lastrow in both workbooks
        With Sheets("Sheet1") 
            Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row 
        End With 
        Application.DisplayAlerts = True 
        Application.ScreenUpdating = True 
        Set fso = CreateObject("scripting.filesystemobject") 
         '***change File path to your file
        Set FilDir = fso.GetFile(ThisWorkbook.Path & "\Datafiles\" & "test.xlsm") 
        workbooks.Open filename:=FilDir 
        For cnt = 1 To Lastrow 
            For Each Wrd In Split(workbooks(FilDir.Name).Sheets("Sheet1").Range("A" & cnt).Value, ", ") 
                If InStr(UCase(ThisWorkbook.Sheets("Sheet1").Range("A" & cnt).Value), UCase(Wrd)) = 0 Then 
                    ThisWorkbook.Sheets("Sheet1").Range("A" & cnt).Value = _ 
                    ThisWorkbook.Sheets("Sheet1").Range("A" & cnt).Value & ", " & Wrd 
                End If 
            Next Wrd 
            Wrd = vbNullString 
        Next cnt 
        ThisWorkbook.Sheets("Sheet1").Range("A1:A" & Lastrow).Copy _ 
        Destination:=workbooks(FilDir.Name).Sheets("Sheet1").Range("A" & 1) 
        Application.CutCopyMode = False 
        workbooks(FilDir.Name).Close SaveChanges:=True 
        Set FilDir = Nothing 
        Set fso = Nothing 
        Application.DisplayAlerts = False 
        Application.ScreenUpdating = False 
    End Sub 
    
    
    Formatting tags added by mark007

  4. #4
    Thanks for all your help. Although the output is a little different from what I wanted, but I manage to solve it.

    I stored all the column headers in arr1. Next, I store all the column headers from worksheet 2 in arr2.

    Next I iterate through each value in arr1, if there are any matching values in arr2. Next, I check the position if they are the same, if they are the same, do nothing. Else if **** the entire column. If it's not there, I add an empty column to the position. Fill the column header with the value of arr1 and re capture all the column header to arr2 before iterating through the next loop.

    This should not be the most efficient way to do it... but that's all I can think of right now.

  5. #5
    Glad U figured it out. Your original request referred to 2 XL files but U solved it with 2 worksheets? U never mentioned anything about headers being present? Did U trial any of the help U received? Anyways, I'm happy that U have resolved this. Thanks for posting your outcome. Dave

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •