An over-simplified description of my problem is illustrated in the figures below. I want to transform sparse data from a column in the Page1 worksheet to dense and then load it in a dense range in the Page2 worksheet.
My solution so far is that in the following code snippet. I would like to know if there is a more efficient alternative to achieve this goal, namely without a for loop or at least without the j variable.
Sub CopyFromMultipleRanges() With Worksheets("Page1") .Range("A1:A5").Value = 1 .Range("A8:A10").Value = 2 Dim c_cell As Range Dim j As Long j = 1 For Each c_cell In .Range("A1:A5,A8:A10") Worksheets("Page2").Range("A" & j).Value = c_cell.Value j = j + 1 Next End With Worksheets("Page2").Activate End Sub
You can do this if you want to remove the blanks on the same sheet. If not just copy the data to a new sheet and then run this on that range
Sub Delete_Blank_Rows() On Error Resume Next Range("A1:A10").Select Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete End Sub
Here’s how I would do it:
'create a collection to store the data Dim bin As New Collection Dim ws1 As Worksheet Dim ws2 As Worksheet Dim size As Long Dim i As Long Dim v As Variant 'set worksheet references Set ws1 = Excel.Application.ThisWorkbook.Worksheets("Page1") Set ws2 = Excel.Application.ThisWorkbook.Worksheets("Page2") With ws1 size = .UsedRange.Rows.Count 'loop through the range to pick up the data from non-empty cells For i = 1 To size 'if the cell is not empty, then add the value to the collection If Not IsEmpty(.Cells(i, 1).Value) Then bin.Add .Cells(i, 1).Value End If Next 'loop through the bin contents i = 1 For Each v In bin ws2.Cells(i, 1).Value = v i = i + 1 Next End With
Hope it helps!
I tested this code and it works:
Sub test() Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Excel.Application.ThisWorkbook.Worksheets(1) Set ws2 = Excel.Application.ThisWorkbook.Worksheets(2) ws1.Range("A:A").SpecialCells(xlCellTypeConstants).Copy ws2.Range("A:A") End Sub
you can read more about Range.SpecialCells here. learn something new everyday!
This assumes that you are considering the all rows with the lower and upper row limits of the ranges given ie. that “A1:A5” and “A8:A10” is indeed “A1:A10”.
Option Explicit Public Sub CopyFromMultipleRanges() Dim rng As Range: Set rng = ThisWorkbook.Worksheets("Page1").Range("A1:A10") Application.ScreenUpdating = False If Application.WorksheetFunction.CountBlank(rng) = rng.Count Then Exit Sub With rng .AutoFilter .AutoFilter 1, "<>" .SpecialCells(xlCellTypeVisible).Copy Worksheets("Page2").Range("A1") .AutoFilter Application.ScreenUpdating = True End With End Sub