Creating an array while skipping random blank columns

[pushkinpassey]

Hi,
I work with spreadsheets exported from a third-party software. The problem is that the exported sheet has random number of blank columns in between the data columns (as shown in the attached spreadsheet).

What I want to do is create a VBA array with the data in the sheet. For the attached data, the array will comprise of 12 rows and 4 columns (H1, H2, H3, H4).

How can I create a simple loop that will fill up my array of (12,4) by skipping the blanks?

Thanks!

samplesheet.xlsx

[Leith Ross]

Hello pushkinpassey,

The attached workbook has the macro below added to it. This will remove the unwanted columns. The macro converts the data on the same on the worksheet.

Module1 Macro Code

Sub Macro1()

    Dim arr     As Variant
    Dim c       As Long
    Dim Data    As Variant
    Dim LastCol As Long
    Dim LastRow As Long
    Dim n       As Long
    Dim r       As Long
    Dim Rng     As Range
    Dim Wks     As Worksheet
    
        Set Wks = Worksheets("Sheet1")
        Set Rng = Wks.Range("F1")
        
            LastCol = Wks.Cells(Rng.Row, Columns.Count).End(xlToLeft).Column
            LastRow = Wks.Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False, False, False).Row
            
            Set Rng = Wks.Range(Rng, Wks.Cells(LastRow, LastCol))
            
            Data = Rng.Value
            
            For c = 1 To Rng.Columns.Count
                If Application.CountA(Rng.Columns(c)) Then
                    n = n + 1
                    For r = 1 To Rng.Rows.Count
                        Data(r, n) = Rng.Item(r, c)
                    Next r
                End If
            Next c
        
        ReDim Preserve Data(1 To Rng.Rows.Count, 1 To n)
        
        Rng.ClearContents
        Rng.Resize(ColumnSize:=n).Value = Data
        
End Sub