Populate non contiguous cells from array (all at once)

MalcolmX

New Member
Joined
Oct 17, 2017
Messages
2
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)
Code:
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
RangeNamesSource
Range1100
Range2200
Range3300
Range4400

<tbody>
</tbody>
 
Last edited by a moderator:

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Hi,
welcome to forum.

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


Place in a STANDARD module

Rich (BB code):
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

Rich (BB code):
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
 
Upvote 0

Forum statistics

Threads
1,214,905
Messages
6,122,178
Members
449,071
Latest member
cdnMech

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top