1

My excel macro is currently concatenating two columns, unit and number. The numbers are pulled up based on a ID and sometimes the number I wish to concatanate the unit with might not be present for that specific ID. I am using find last row, but that does not work in some scenarios as the number I want to concatanate with the unit only starts on row 6, sometimes row 8, but it will at least start on row 2. Row 1 contains the title.

I want to ignore the empty rows, and without giving it a range to look up to row 100 for example because I might have more than 100 rows sometimes. The code below is what I currently have and works if the column is fully populated until the end.

rowEmpty = 2
    Do While IsEmpty(ws_Export.cells(rowEmpty, 9)) = False
        rowEmpty = rowEmpty + 1
    Loop
    'rowEmpty is now set as the first empty row (sets the range of the table)
    
    'Add units within the same cell as the shunt
    For s = 2 To rowEmpty - 1
        cells(s, 9) = cells(s, 9) & " " & cells(s, 8)
Next s

two columns I wish to concatanate

braX
  • 11,506
  • 5
  • 20
  • 33
ijauhe
  • 41
  • 2
  • In your `Do...While` change the `9` to an `8` so it scans column `H` instead of column `I` to get `rowEmpty`. (don't change the other `9`'s) – braX Mar 29 '23 at 14:59
  • Why don't you just define a range [finding the last used cell in the column](https://stackoverflow.com/questions/11169445/find-last-used-cell-in-excel-vba)? – Evil Blue Monkey Mar 29 '23 at 15:20

1 Answers1

0

Concatenate If Not Blank

  • Replace the J with I to replace as required.

enter image description here

Option Explicit

Sub AppendUnits()

    Const WS_NAME As String = "Export"
    Const CAL_FIRST_CELL As String = "I2"
    Const UNIT_COLUMN As String = "H"
    Const DST_COLUMN As String = "J" ' Result
    Const DELIMITER As String = " "
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet: Set ws = wb.Sheets(WS_NAME)
    
    Dim crg As Range, rCount As Long
    
    With ws.Range(CAL_FIRST_CELL)
        Dim lCell As Range: Set lCell = .Resize(.Worksheet.Rows.Count _
            - .Row + 1).Find("*", , xlFormulas, , , xlPrevious)
        If Not lCell Is Nothing Then
            rCount = lCell.Row - .Row + 1
            Set crg = .Resize(rCount)
        End If
    End With
    
    If crg Is Nothing Then
        MsgBox "No data found.", vbCritical
        Exit Sub
    End If
    
    Dim urg As Range: Set urg = crg.EntireRow.Columns(UNIT_COLUMN)
    
    Dim cData(), uData()
    
    If rCount = 1 Then
        ReDim cData(1 To 1, 1 To 1): cData(1, 1) = crg.Value
        ReDim uData(1 To 1, 1 To 1): uData(1, 1) = urg.Value
    Else
        cData = crg.Value
        uData = urg.Value
    End If
    
    Dim r As Long, rStr As String
    
    For r = 1 To rCount
        rStr = CStr(cData(r, 1))
        If Len(rStr) > 0 Then
            cData(r, 1) = rStr & DELIMITER & CStr(uData(r, 1))
        End If
    Next r
    
    Dim drg As Range: Set drg = crg.EntireRow.Columns(DST_COLUMN)
    
    drg.Value = cData
    
    MsgBox "Units appended.", vbInformation
    
End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28