Concatenate Two Cells Into One Cell Everytime There Are New Data Row Added

70 Views Asked by At

I'm having trouble to create vba code to concatenate two cells into one cell. Those two cells consists of number and text.

I already create code to import data from another workbook and make vba paste the data to the next row available by using offset(1,0). But, i have no idea how to make vba concatenate each cells in column A & B into cells in column C.

I wish to concatenate it with underscore between them: Cells A_Cells B

Thank you in advance

'Import Data
    Dim FileToOpen As Variant
    Dim openbook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", Filefilter:="Excel Files (*.xlsx),*.xlsx")
    If FileToOpen <> False Then
        Set openbook = Application.Workbooks.Open(FileToOpen)
        openbook.Sheets(1).Range("A1").CurrentRegion.Copy
        ThisWorkbook.Worksheets("NO PK").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        openbook.Close False
    End If
    Application.ScreenUpdating = True
2

There are 2 best solutions below

0
taller On BEST ANSWER
  • Assign values to cells is more efficient than Copy/PasteSpecial.

  • Apply formulas to concate Col A & B, then convert formulas to values.

Microsoft documentation:

Range.FormulaR1C1 property (Excel)

Range.Resize property (Excel)

    Dim FileToOpen As Variant
    Dim openbook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", Filefilter:="Excel Files (*.xlsx),*.xlsx")
    If FileToOpen <> False Then
        Set openbook = Application.Workbooks.Open(FileToOpen)
        Dim srcRng As Range, RowCnt As Long, ColCnt As Long
        Set srcRng = openbook.Sheets(1).Range("A1").CurrentRegion
        RowCnt = srcRng.Rows.Count
        ColCnt = srcRng.Columns.Count
        With ThisWorkbook.Worksheets("NO PK").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(RowCnt, ColCnt)
            .Value = srcRng.Value
            With .Columns(3)  ' Col C
                ' Apply formula to concate Col A, Col B
                .FormulaR1C1 = "=RC[-2] & ""-"" & RC[-1]"
                ' Convert formulas to values
                .Formula = .Value
            End With
        End With
        openbook.Close False
    End If
    Application.ScreenUpdating = True
0
VBasic2008 On

Import Data From Closed Workbook

Sub ImportData()

    ' Define constants.
    Const HEADER_ROWS As Long = 0 ' adjust!

    ' Open source file.
    Dim FileToOpen As Variant
    FileToOpen = Application.GetOpenFilename( _
        Title:="Browse for your File & Import Range", _
        Filefilter:="Excel Files (*.xlsx),*.xlsx")
    If VarType(FileToOpen) = vbBoolean Then Exit Sub ' dialog canceled
    
    Application.ScreenUpdating = False
    
    ' Reference (set) the source objects.
    Dim swb As Workbook: Set swb = Workbooks.Open(FileToOpen)
    Dim sws As Worksheet: Set sws = swb.Worksheets(1)
    Dim srg As Range:
    With sws.Range("A1").CurrentRegion
        Set srg = .Resize(.Rows.Count - HEADER_ROWS).Offset(HEADER_ROWS)
    End With
         
    ' Reference (set) the destination objects.
    Dim dwb As Workbook: Set dwb = ThisWorkbook
    Dim dws As Worksheet: Set dws = dwb.Sheets("NO PK")
    Dim dcell As Range: ' next available cell in column 'A'
    Set dcell = dws.Cells(dws.Rows.Count, "A").End(xlUp).Offset(1)
    Dim drg As Range: ' same size as the source range
    Set drg = dcell.Resize(srg.Rows.Count, srg.Columns.Count)
    
    ' Copy values and close the source workbook.
    drg.Value = srg.Value
    swb.Close SaveChanges:=False
    
    ' Concat columns 'A' and 'B' in 'C'.
    With drg.EntireRow
        .Columns("C").Value = dws.Evaluate(.Columns("A").Address _
            & "&""_""&" & .Columns("B").Address)
    End With
    
    ' Save the destination workbook.
    'dwb.save
    
    Application.ScreenUpdating = True
    
    ' Inform.
    MsgBox "Data imported.", vbInformation

End Sub