VBA Copy Data With Blanks But automatically Paste with "N/A" Within Blank Spots-CodePudding

I want to copy data with blanks, but automatically fill the blanks with the string "N/A" Once pasted without using Replace. The data files I'm copying from are quite large and want to avoid just filling all the cells that are blank with "N/A"

Example of what I Don't want to use.

Range("A:A").Replace What:="", Replacement:="N/A"

The Problem :

The problem I run into is that I iterate through many data files looking for certain data points based off a selection from a user form list box and paste specific data points into a new result file. But the data gets mismatched if there are blanks as I just paste the copied data into the next empty cell within a certain column. So I end up with conditions where data doesn't line up and want to input "N/A' where there are blanks.

Example of the problem and what I want too achieve:

enter image description here

Copy Paste Loop :

For n = 0 To ListBox2.ListCount - 1
                If ListBox2.Selected(n) = True Then
                    Windows(DataFileName).Activate
                    Set FoundString = Sheets(1).Rows("1").Find(What:=ListBox2.List(n), LookIn:=xlValues, LookAt:=xlWhole)        'Search For File Attributes
                    ColumnLetter = Split(Cells(1, FoundString.Column).Address, "$")(1)        'Convert Column Number to Letter
                    Range(ColumnLetter & "2:" & ColumnLetter & LastRow).Copy
                    Windows(ResultsFileName).Activate        'Open Results File
                    Set FoundString = Sheets("Results").Rows("1").Find(What:=ListBox2.List(n), LookIn:=xlValues, LookAt:=xlWhole)        ' Search For File Attributes within Result File
                    ColumnLetter = Split(Cells(1, FoundString.Column).Address, "$")(1)        'Convert Column Number to Letter
                    Range(ColumnLetter & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            End If

CodePudding user response：

Once you have a Range for the data that you will be copying, you can take the values into an array, change all Empty values into "N/A" and then paste it into your destination Range.

Sub Example()
    Dim CopyRange As Range
    Set CopyRange = ThisWorkbook.Worksheets(1).Range("A1:A8")
    
    Dim DestinationRange As Range
    Set DestinationRange = ThisWorkbook.Worksheets(1).Range("B1:B8")
    
    'Take the values from the CopyRange into an array
    Dim Values() As Variant
    Values = CopyRange.Value
    
    'Loop through the 2D array
    Dim i As Long, j As Long
    For i = LBound(Values, 1) To UBound(Values, 1)
        For j = LBound(Values, 2) To UBound(Values, 2)
            'Change blank values into "N/A"
            If IsEmpty(Values(i, j)) Then Values(i, j) = "N/A"
        Next
    Next
    
    'Paste the values into the destination range
    DestinationRange.Value = Values
End Sub

Here's an example using your code snippet above.

Sub Example2()

    Dim n As Long
    For n = 0 To ListBox2.ListCount - 1
        If ListBox2.Selected(n) = True Then
            Dim ListBox2Val As Variant
            ListBox2Val = ListBox2.List(n)
        
            Dim DF As Workbook
            Set DF = Windows(DataFileName).Parent
            
            Dim DS As Worksheet
            Set DS = DF.Worksheets(1)
            
            Dim DataValues() As Variant
            Set FoundString = DS.Rows("1").Find(What:=ListBox2Val, LookIn:=xlValues, LookAt:=xlWhole)        'Search For File Attributes
            DataValues = FoundString.EntireColumn.Cells(2, 1).Resize(LastRow - 1).Value
            
            'Loop through the 2D array
            Dim i As Long, j As Long
            For i = LBound(DataValues, 1) To UBound(DataValues, 1)
                For j = LBound(DataValues, 2) To UBound(DataValues, 2)
                    'Change blank values into "N/A"
                    If IsEmpty(DataValues(i, j)) Then DataValues(i, j) = "N/A"
                Next
            Next
            
            Dim RF As Workbook
            Set RF = Windows(ResultsFileName).Parent
            
            Dim RS As Worksheet
            Set RS = RF.Worksheets("Results")
            
            Set FoundString = RS.Rows("1").Find(What:=ListBox2Val, LookIn:=xlValues, LookAt:=xlWhole)        ' Search For File Attributes within Result File
            FoundString.EntireColumn.Cells(RS.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(DataValues, 1)).Value = DataValues
        End If
    Next
End Sub

This example was based off of the code snippet you posted and is not a complete example. I am missing the definition for ListBox2, LastRow, DataFileName, ResultsFileName, FoundString, n