Concatenate a Variable Number of Fields

Viewed 82

I will do my best to word what I am hoping to achieve.

I have an Excel workbook that is made of the metadata for numerous folders and their associated documents within. Each line is occupied by the different documents for each folder. So, 1 folder may have 1 document in it, so it occupies 1 row while another may have 4 documents which will occupy 4 rows. The documents have each of their parent folders assigned to them in a column. I have to take this data and reformat it for a client.

One of the reformatted cells has to be a concatenation of 5 cells within the report, Q, U, Y, AC, AG. The new cell would have their values pieced together in a string, "Term 1: Q; Term 2: U, etc...". The tricky part is not all of the columns may have values.

I currently create an array of all unique values within the folder column that filters the data by each. I was having issues in writing a simple VBA code that finds the cells within those 5 columns that are non-blank and creates the new string formatted as previously mentioned. As a self-taught VBA novice, I can only think of nested Ifs basically accounting for all possible combinations which is A) not fun and B) slow af.

Any help/guidance would be highly appreciated.

Example data below:

Deal Id Term 1 Term 2 Term 3 Term 4
ABC 2/2/21 3/1/21 4/14/21
DEF 1/1/21 2/1/21
GHI 3/1/21 3/5/21 4/15/21 5/15/21
Sub Prep()

    Application.ScreenUpdating = False
    
    Dim wb As Workbook
    Dim Col, Col_Letter, r, g, h, filter_Col As String
    Dim strArray  As Variant
    Dim TotalRows As Long
    Dim vArr
    Dim arTmp
    Dim securities As Variant
    Dim counter As Long, I, Rng As Long, files As Integer
    
    
    Set wb = ActiveWorkbook
    'Takes all of the Deal IDs and pastes them unto a new sheet and removes duplicates
    ActiveSheet.Range("A1:H1").Find("JPMC-Loan / Deal ID").Select
    Col = WorksheetFunction.Match("JPMC-Loan / Deal ID", ActiveWorkbook.ActiveSheet.Range("1:1"), 0)
    Col_Letter = Split(Cells(1, Col).Address, "$")(1)
    r = Col_Letter & "2"
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "Array"
    Sheets("Sheet1").Select
    Range(r, Range(r).End(xlDown)).Select
    Selection.Copy
    Sheets("Array").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("A1").Select
    
    'Creates an array of the unique Deal ID values that we will later fitler on
    Dim wb1 As Workbook
    Set wb1 = ActiveWorkbook

    Dim RowNumber As Long
    RowNumber = wb1.Sheets("Array").UsedRange.Rows.Count

    ReDim idArray(RowNumber) As String
    Dim j As Long
    For j = 1 To RowNumber
        idArray(j - 1) = CStr(wb1.Sheets("Array").Cells(j, 1).Value)
    Next j

    ReDim Preserve idArray(UBound(idArray) - 1)
    
    'Time to filter the export and work deal by deal
    Sheets("Sheet1").Activate
    For I = 0 To UBound(idArray)
       'Finds the first row after the filter to copy just the metadata
        Col = WorksheetFunction.Match("Deal ID", ActiveWorkbook.ActiveSheet.Range("1:1"), 0)
        Col_Letter = Split(Cells(1, Col).Address, "$")(1)
        g = Col_Letter & "1"
        Range(g).AutoFilter field:=Col, Criteria1:=idArray(I)
        files = Sheets("Sheet1").AutoFilter.Range.Columns(Col).SpecialCells(xlVisible).Count
        filter_Col = Sheets("Sheet1").UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row
        
        
        
        ‘Date
        Dim Rng, val As String, i, r, p As Integer, mature As Variant
    i = 0
    
    
    
    Worksheets("Sheet1").Range("Q" & Rows.Count).End(xlUp).Offset(1).Select
    If Selection.Row - 1 > 1 Then
        i = i + 1
        Sheets("Sheet1").Range("Q" & Sheet1.Rows.Count).End(xlUp).Select
        val = "Term Loan " & i & ": " & Selection.Value
        Selection.Copy
        'MsgBox (Sheets("Sheet1").Range("Q" & Sheet1.Rows.Count).End(xlUp).Row)
        Range("F7").PasteSpecial Paste:=xlPasteValues
    Else
        MsgBox ("nada")
    End If
        Selection.AutoFilter
    Next I
End Sub

Function AddPause()
 
    ' Written by: FormatCells.com
    ' For the best custom made spreadsheets, visit: www.formatcells.com
     
    Application.ScreenUpdating = True
     
    f_wait.Show
     
    Do Until f_wait.Visible = False
     
    DoEvents
     
    Loop
     
    Application.ScreenUpdating = False
 
End Function

I cut out the chunks of code that work as intended. There is a large portion of code that is just selecting a cell and pasting the value onto my template.

It does not work as well I would hope, and I cannot think of way around nested Ifs to account for all combinations. I thought about leveraging an array, but from my understanding, you cannot append to an array like I would in Python. I had hoped to check if the column has any non blank cells in it, if it does, append "Term 1: (Cell value)" and repeat through the columns.

1 Answers

Not sure why nested ifs would be super slow with VBA. How many lines are you processing? Sometimes the not so elegant works just fine. Another option is to just concatenate and then replace any double spaces (caused by blank cells) with a single space, but this could lead to problems if the data has any double spaces in it. Another option would be to concatenate rarely used characters as your spaces (e.g. "#") and then do two find and replaces (the first swapping double ## for a space, the second to swap # for a space).

Related