Consulting

Results 1 to 5 of 5

Thread: Manipulate 2 different columns to become one

  1. #1
    VBAX Regular
    Joined
    Dec 2017
    Posts
    16
    Location

    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
    VBAX Expert
    Joined
    Sep 2016
    Posts
    634
    Location
    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

    マナ

  3. #3
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    559
    Location
    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

  4. #4
    VBAX Regular
    Joined
    Dec 2017
    Posts
    16
    Location
    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
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    559
    Location
    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
  •