Non-contiguous visible cells only selection to Array

mirology

New Member
Joined
Oct 9, 2015
Messages
20
I need the user to select anything he want from filtered data or even non contiguous selection then put his selection into a 2-D array VARIABLE ROWS and Columns depends on user selection ...

because Array1=Application.selection.value ...has 2 limitations :

1) the selection has to be contiguous
2) Doesn't Copy the visible cells only it copies everything ...



my whole code is designed on the Array so its not an option to change it .. if someone has idea ??
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
There may be a better method than this, but this might work for you.
Essentially, it adds a new worksheet, copies the visible cells to it. then loads the range from from the new worksheet to an array. then deletes the new worksheet -- leaving you with the range.
Code:
Sub test()    Dim shizzlE As Worksheet, selRange As Range, lastRow As Long, lastColumn As Integer, theArray
    


    Set selRange = Selection


    Set shizzlE = ActiveWorkbook.Worksheets.Add
    selRange.Parent.Activate
    selRange.Select
    
    Selection.SpecialCells(xlCellTypeVisible).Copy Destination:=shizzlE.Range("a1")
    lastRow = shizzlE.Cells(shizzlE.Rows.Count, "a").End(xlUp).Row
    lastColumn = shizzlE.Cells(1, shizzlE.Columns.Count).End(xlToLeft).Column
    theArray = shizzlE.Range(shizzlE.Cells(1, 1), shizzlE.Cells(lastRow, lastColumn))
    Application.DisplayAlerts = False
        shizzlE.Delete
    Application.DisplayAlerts = True
    

    


End Sub
 
Upvote 0
If you wanted either all visible cells written into the array or user selected columns, which must be contiguous including the header rows, you can use one of these two methods as indicated. One or the other must be commented out. I do not have a solution for non-contiguous selections and partial column selections.

Code:
Sub filterToArray()


    Dim ws As Worksheet: Set ws = Worksheets("Sheet1")
    Dim rngVisible As Range, rCell As Range
    Dim myArray() As Variant
    Dim lCol As Long, i As Long, x As Long
 
    With Sheets("Sheet1")  '<---Adjust
         If .AutoFilterMode = False Then MsgBox "No filter set up", vbCritical: Exit Sub
        'Set the visible range
        With .AutoFilter.Range
            lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
            
            'Use this for all visible cells
            
            Set rngVisible = .Offset(1, 0).Resize(.Rows.Count - 1, lCol) _
                  .SpecialCells(xlCellTypeVisible)
                  
            'Use this for selected continguous columns. Selection must include header row.
            
            'Set rngVisible = .Offset(1, 0).Resize(Selection.Rows.Count, Selection.Columns.Count) _
                .SpecialCells(xlCellTypeVisible)
            
        End With
        i = rngVisible.Cells.Count
        ReDim myArray(1 To i, 1 To 1)
        i = 0
        'Loop through visible range and populate the array
        For Each rCell In rngVisible
            i = i + 1
            myArray(i, 1) = rCell
        Next rCell
    End With
    
End Sub

I hope this gets you closer...
 
Upvote 0
Sorry... this isn't thread specific, but i couldnt help myself. igold! I'm a drinker with a coding problem too!!! hilarious signature.
 
Upvote 0
Thanks for helping with the codes was really useful ... ODIN method was simple and applicable also avoided the hustle of Array Dim and ReDim and works with non contiguous ranges.
 
Upvote 0
Sorry... this isn't thread specific, but i couldnt help myself. igold! I'm a drinker with a coding problem too!!! hilarious signature.

If I could only stop at the alcohol, I would almost know what I was doing...

Cheers!!!
 
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,262
Members
452,627
Latest member
KitkatToby

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