Populate non contiguous cells from array (all at once)

[MalcolmX]

Hi. I have developed a workbook which is to be used for data capture and producing xml to run through a Matlab model and receive xml response.

Data will eventually be stored in a database but currently I am posting it into a text file. Every data entry cell in the workbook has a named range so the data exported into these text files will contain the of the named range and value entered.

My issue is when re-importing this data into the form (as the user may need to edit or update it), I transfer from the text file into an array. I am currently populating the named ranges by looping through the array and this works ok but despite all my efforts, the screen flickers around (despite screen updating being false) and I'm worried it might get slow given what the client wants me to do with the workbook. Ultimately, there could be up to 10,000+ named ranges to populate.

So I'm curious whether its possible to get VBA to point to all the named ranges at once and populate with the values in one go rather than looping through the array?

I can get VBA to point to all the cells but can only populate them with a single value (100 in the example below) and not the separate values for each named range/cell.

The code and table below shows a simple example. Any help will be appreciated

The named ranges Range1, Range2, Range3 and Range4 are individual named cells randomly placed in the sheet (i.e. non contiguous)

Sub CopyPasteFromArray()


    Dim arrData() As Variant
    Dim arrRanges() As Variant
    
    Dim sRng As String
    Dim x As Long
    
    'transfer data to array
    arrData() = Range("Source")
    arrRanges() = Range("RangeNames")
    
    sRng = ""
    For x = LBound(arrRanges) To UBound(arrRanges)
        
        If x = LBound(arrRanges) Then
            sRng = arrRanges(x, 1)
        ElseIf x > LBound(arrRanges) And x <= UBound(arrRanges) Then
            sRng = sRng & "," & arrRanges(x, 1)
        End If
        
    Next x
    
    Range(sRng).Value = arrData

End Sub

My data
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]RangeNames[/TD]
[TD]Source[/TD]
[/TR]
[TR]
[TD]Range1[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]Range2[/TD]
[TD]200[/TD]
[/TR]
[TR]
[TD]Range3[/TD]
[TD]300[/TD]
[/TR]
[TR]
[TD]Range4[/TD]
[TD]400[/TD]
[/TR]
</tbody>[/TABLE]

 

[dmt32]

Hi,
welcome to forum.

Assuming your database worksheet has one record per row then try following:


Place in a STANDARD module

Sub DatabaseToDataEntry(ByVal InputFormRange As Range, ByVal Target As Range)
    'dmt32 Oct 2017
    Dim Cell As Range
    Dim i As Integer
    Dim CellCount As Long
    Dim Data As Variant
    
'count of input cells
    CellCount = InputFormRange.Cells.Count
'create array from range
    Data = Application.Transpose(Target.Parent.Cells(Target.Row, 1).Resize(1, CellCount).Value)


    On Error GoTo exitsub
'turn event code off
    Application.EnableEvents = False
    i = 1
    With InputFormRange.Parent
'step thru each cell in named range
        For Each Cell In InputFormRange
'check if input form range has formula
            If Not .Cells(Cell.Row, Cell.Column).HasFormula Then
'return data to correct cell in form
                .Cells(Cell.Row, Cell.Column).Value = Data(i, 1)
            End If
'increment to next array element
            i = i + 1
        Next Cell
    End With
    
exitsub:
'turn event code on
    Application.EnableEvents = True
    On Error GoTo 0
End Sub

Example use

Sub ExampleUseCode()
    Dim Foundcell As Range, DataEntryRange As Range
    
'the data entry range of your input form
'change worksheet name & data entry range as required
'the data entry range must be in the order record appears in the database
'in this example C6 = Column A, C8 = Column B, F6 = Column C etc.
    Set DataEntryRange = ThisWorkbook.Worksheets("Data Entry Form").Range("C6,C8,F6,C10,G8,H12,D12")
    
'this is an example of a range with record in your Database Worksheet to be returned
'you only need to find the first cell in the Row of required record in your database
    Set Foundcell = Worksheets("Database").Range("A2")
    
'return required database record to your data entry form
    DatabaseToDataEntry DataEntryRange, Foundcell


End Sub

Change values in RED as required.

Code can be used with other data entry sheets if required.

Hope Helpful

Dave

 

[MalcolmX]

Thanks Dave. I'll play around with this and see how it goes. Thanks