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.