VBA to Combine all non-empty rows from one column into another column

[S3RG388]

Hi All,

I am new to this Forum, so nice to meet you all and looking forward to participating in this community

I need some help/tips/examples for writing a macro that takes all non-empty entries in one column and pastes them into another column (starting from a specified row)... Should it be done through VBA or nested IF(OFFSET(MATCH())) functions?

I can achieve it through the nested functions but the spreadsheet becomes extremely slow and there is no way to check how long to extend the formula for (e.g. how many empty rows to include it to make it strictly = to the count of entries in the parent column and then stop)...

I also need to insert two rows with static text at the end of the newly pasted column (to specify END-OF-ARRAY, END-OF-FILE), again this could be achieved through the function nesting but I am yet to resolve the issue of counting and stopping formulas beyond last entry.

Any help would be greatly appreciated!!!

Thanks guys =)

 

[mikerickson]

It sounds like VBA is the way to go.

I would use a routine like

Dim sourceColumn As Range
Dim DestinationColumn As Range
Dim DestinationStartRow as Long

Set SourceColumn = ThisWorkbook.Sheets("Sheet1").Range("A:A")
Set DestinationColumn = ThisWorkbook.Sheets("Sheet2").Range("B:B")

With SourceColumn.EntireColumn
    Set SourceColumn = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)
End With

With DestinationColumn.EntireColumn
    Set DestinationColumn.Cells(DestinationStartRow, 1).Resize(SourceColumn.Rows.Count, 1)
End With

With DestinationColumn
    .Value = SourceColumn.Value
    .Offset(.Rows.Count,0).Value = "End Of Array"
    .Offset(.Rows.Count + 1, 0).Value = "End Of File"
End With

 

[My Aswer Is This]

Glad to see you on the Forum
Any tine you post questions we need specific details:
You said:
I need some help/tips/examples for writing a macro that takes all non-empty entries in one column and pastes them into another column (starting from a specified row)...

You said from one column we need to know what column and you said paste them into another column.

What other column?

And you said: starting from a specified row

What specific row?

 

[S3RG388]

It sounds like VBA is the way to go.

I would use a routine like

Dim sourceColumn As Range
Dim DestinationColumn As Range
Dim DestinationStartRow as Long

Set SourceColumn = ThisWorkbook.Sheets("Sheet1").Range("A:A")
Set DestinationColumn = ThisWorkbook.Sheets("Sheet2").Range("B:B")

With SourceColumn.EntireColumn
    Set SourceColumn = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)
End With

With DestinationColumn.EntireColumn
    Set DestinationColumn.Cells(DestinationStartRow, 1).Resize(SourceColumn.Rows.Count, 1)
End With

With DestinationColumn
    .Value = SourceColumn.Value
    .Offset(.Rows.Count,0).Value = "End Of Array"
    .Offset(.Rows.Count + 1, 0).Value = "End Of File"
End With

Thanks, I am going to try this - seems like it will work!

The only specific requirement I have is to start the data population not from the beginning of source column (A:A) but from a specific cell, say A15. I assume that would just translate into A15:A instead of A:A?

Also, to start population not from the beginning of the destination column, but from a specific cell, say B15. That would also translate into B15:B I assume?

If so, the code should be right for my purpose!!

MyAnswerIsThis - see above, I need to specify a start cell of both source and destination columns and the rest will be dictated by the size of the data (e.g. variable until all entries are copied across). So, source column starting from A15 until all data is processed and destination column from B15 until all data is processed. Also source and destination columns are in two separate tabs, but that would just be TabNameA15:A I assume?

 

[My Aswer Is This]

Since you did not give us the two sheet names this script assumes the sheets are Sheet(1) and Sheet(2)

Not sure why you seemed a little vague when you said:
say A15
say B15
When you use the term "say" it sounds like your not sure.
And you said:

Also source and destination columns are in two separate tabs, but that would just be TabNameA15:A I assume?

What does I assume mean. You should know what the sheet names are it's your workbook.


Try this:

Sub Copy_Non_Blank_Cells()
Application.ScreenUpdating = False
Dim c As Range
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = 15
Sheets(1).Activate
    For Each c In Sheets(1).Range("A15:A" & Lastrow)
        If c.Value <> "" Then
            c.Copy Sheets(2).Range("B" & Lastrowa)
            Lastrowa = Lastrowa + 1
        End If
    Next
Sheets(2).Range("B" & Lastrowa).Value = "End of Array"
Sheets(2).Range("B" & Lastrowa + 1).Value = "End of File"
Application.ScreenUpdating = True
End Sub

 

[S3RG388]

Thank you - apologies for ambiguity, I am still at the design stage and hence haven't decided on my tab names and where exactly my arrays will begin!

The only thing is that I need to insert END of array rows at the end of my destination array, does the above aim to do that or is it inserting at the end of source array? Anyway I will test both as soon as I get home, thanks!!

 

[My Aswer Is This]

It does what you asked as far as I understand. I would suggest trying it.

Thank you - apologies for ambiguity, I am still at the design stage and hence haven't decided on my tab names and where exactly my arrays will begin!

The only thing is that I need to insert END of array rows at the end of my destination array, does the above aim to do that or is it inserting at the end of source array? Anyway I will test both as soon as I get home, thanks!!

 

[Rick Rothstein]

I made the same assumptions about the location of your data as My Aswer Is This. In addition, my code assumes the cells in Column A on Sheet1 does not contain any formulas. Given that, here is another macro that you can consider...

[table="width: 500"]
[tr]
	[td]Sub Copy_Non_Blank_Cells()
  With Sheets("Sheet1")
    Intersect(.Columns("A"), .Range("A15", .Cells(Rows.Count, "A").End(xlUp)).EntireRow).Copy Sheets("Sheet2").Range("B15")
  End With
  Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Offset(1).Resize(2) = [{"End of Array";"End of File"}]
End Sub[/td]
[/tr]
[/table]

 

[My Aswer Is This]

Try this non looping script:

Sub Simple_Filter_New()
Application.ScreenUpdating = False
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
  
  With Range("A15:A" & Lastrow)
    .AutoFilter Field:=1, Criteria1:="<>" & ""
        .SpecialCells (xlCellTypeVisible)
        .Copy Worksheets("Sheet2").Range("B15")
    End With
    
    Lastrowa = Sheets(2).Cells(Rows.Count, "B").End(xlUp).Row + 1
    Sheets(2).Range("B" & Lastrowa).Value = "End of Array"
    Sheets(2).Range("B" & Lastrowa + 1).Value = "End of File"
    
    ActiveSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

 

[S3RG388]

Try this non looping script:

Sub Simple_Filter_New()
Application.ScreenUpdating = False
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
  
  With Range("A15:A" & Lastrow)
    .AutoFilter Field:=1, Criteria1:="<>" & ""
        .SpecialCells (xlCellTypeVisible)
        .Copy Worksheets("Sheet2").Range("B15")
    End With
    
    Lastrowa = Sheets(2).Cells(Rows.Count, "B").End(xlUp).Row + 1
    Sheets(2).Range("B" & Lastrowa).Value = "End of Array"
    Sheets(2).Range("B" & Lastrowa + 1).Value = "End of File"
    
    ActiveSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

Thanks, the script is working but is unstable - every time I run it once and (manually for now) clear out the new range in my destination file, I get a runtime error... Perhaps I need to specify variable purge somewhere in the script?

Firstly, when I try to run the below (below is the script with my actual parameters and addition of worksheet. command where I need to refer the range to a specific worksheet):



Sub Request_File()
Application.ScreenUpdating = False
Dim Lastrow As Long
Lastrow = Worksheets("InputFile").Cells(Rows.Count, "H").End(xlUp).Row
With Range("H7:H" & Lastrow)
.AutoFilter Field:=1, Criteria1:="<>" & ""
.SpecialCells (xlCellTypeVisible)
.Copy Worksheets("RequestFile").Range("B15")
End With

LastrowA = Sheets("RequestFile").Cells(Rows.Count, "B").End(xlUp).Row + 1
Sheets("RequestFile").Range("RequestFile!B" & LastrowA).Value = "END-OF-DATA"
Sheets("RequestFile").Range("RequestFile!B" & LastrowA + 1).Value = "END-OF-FILE"

ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub



I keep getting the following error:
'Run-time error 1004':


The command could not be completed by using the range specified.
Select a single cell within the range and try the command again.

Again, do you think I need to add range variable clearing component into the script?