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 =)

 

[S3RG388]

Actually, your first suggestion works perfect and doesn't produce range errors!:

Sub Copy_Non_Blank_Cells()
Application.ScreenUpdating = False
Dim c As Range
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets("InputFile").Cells(Rows.Count, "H").End(xlUp).Row
Lastrowa = 15
Sheets("InputFile").Activate
For Each c In Sheets("InputFile").Range("H7:H" & Lastrow)
If c.Value <> "" Then
c.Copy Sheets("RequestFile").Range("B" & Lastrowa)
Lastrowa = Lastrowa + 1
End If
Next
Sheets("RequestFile").Range("B" & Lastrowa).Value = "END-OF-DATA"
Sheets("RequestFile").Range("B" & Lastrowa + 1).Value = "END-OF-FILE"
Application.ScreenUpdating = True
End Sub


Thanks so much.

Now I just need to add a clearing function within the macro to make it clear all of the cells from B15 onwards in the destination file prior to range copy over.
Will try adding:

Dim lRow As Long
lRow = Worksheets("RequestFile").Cells(Rows.Count, 2).End(xlUp).Row
MsgBox "Last Row: " & lRow & vbNewLine
Range("B15:B" & lRow).Clear

between the Lastrow and LastrowA calls and their definitions.

 

[My Aswer Is This]

It looks like you have changed around all your parameters and now are trying to change the script.

That's why it's best unless you know how to do it you should provide us with the proper parameters.

I see several problems with your script but not knowing for sure what you want I will need more information to help you.

 

[S3RG388]

Apologies, but as I said - I was previously in design mode and now actually applying it to my data samples.

I have added final touches (clearing functionality) and tested with missing entries in both existing from previous run destination range and the input range - it works perfectly fine and runs very quick.

Sub Request_File()
Application.ScreenUpdating = False
Dim c As Range
Dim Lastrow As Long
Dim Lastrowa As Long
Dim lRow As Long
lRow = Worksheets("RequestFile").Cells(Rows.Count, 1).End(xlUp).Row
MsgBox "Request File Prepared"
Range("A27:A" & lRow).Clear
Lastrow = Sheets("InputFile").Cells(Rows.Count, "H").End(xlUp).Row
Lastrowa = 27
Sheets("InputFile").Activate
For Each c In Sheets("InputFile").Range("H7:H" & Lastrow)
If c.Value <> "" Then
c.Copy Sheets("RequestFile").Range("A" & Lastrowa)
Lastrowa = Lastrowa + 1
End If
Next
Sheets("RequestFile").Range("A" & Lastrowa).Value = "END-OF-DATA"
Sheets("RequestFile").Range("A" & Lastrowa + 1).Value = "END-OF-FILE"
Application.ScreenUpdating = True
End Sub



To clarify what I'm achieving through the above - clear existing data in the range A27 to last cell of the sheet 'RequestFile'. Copy across all non-empty entries starting from cell H7 and until the last cell of the sheet 'InputFile'. Add the text END tags in the end of the array. If you see any issues with my latest (above) modification of your initial great suggestion, please let me know =) Otherwise, thanks once more!!

 

[My Aswer Is This]

This filtering script is a better choice.
See it this works for you.

Sub Request_File_New()
Application.ScreenUpdating = False
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Worksheets("InputFile").Cells(Rows.Count, "H").End(xlUp).Row
Lastrowa = Sheets("RequestFile").Cells(Rows.Count, "B").End(xlUp).Row + 1
Sheets("RequestFile").Range("B15:B" & Lastrowa).Clear

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("B" & Lastrowa).Value = "END-OF-DATA"
Sheets("RequestFile").Range("B" & Lastrowa + 1).Value = "END-OF-FILE"
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

 

[S3RG388]

Sure, I guess I can use either then - is the latter less operationally demanding (e.g. less demanding on memory/performance)?

 

[My Aswer Is This]

If your script works for you and you like it that's great.
I like seeing people who are learning Vba.

But I'm sure someone else on the forum will not like seeing you using a looping script normally they say they are too slow.

But normally if your just working with less the 10,000 rows you will see just a few seconds difference.

Now I see you have made a few more changes so if you want to use the Filtering script you may need to make a few changes.