Excel - Copy a range if the a specific column is blank

January 2017




Issue


I'm trying to copy a row of data from column A - G if column D from row 8 - 209 is blank to the bottom of my spreadsheet. I used the following coding, but it's copying the whole row instead of up to column G.

Sub Unposted()  

Dim LSearchRow As Integer  
Dim LCopyToRow As Integer  

On Error GoTo Err_Execute  

'Start search in row 8  
LSearchRow = 8  

'Start copying data to row 170 in WSO - 480251444 (Op) (row counter variable)  
LCopyToRow = 223  

While Len(Range("A" & CStr(LSearchRow)).Value) > 0  

'If value in column D = "", copy entire row to WSO - 480251444 (Op)  
If Range("D" & CStr(LSearchRow)).Value = "" Then  

'Select row in WSO - 480251444 (Op) to copy  
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select  
Selection.Copy  

'Paste row into WSO - 480251444 (Op) in next row  
Sheets("WSO - 480251444 (Op)").Select  
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select  
ActiveSheet.Paste  

'Move counter to next row  
LCopyToRow = LCopyToRow + 1  

'Go back to Sheet1 to continue searching  
Sheets("WSO - 480251444 (Op)").Select  

End If  

LSearchRow = LSearchRow + 1  

Wend  

'Position on cell A4  
Application.CutCopyMode = False  
Range("A4").Select  

MsgBox "All matching data has been copied."  

Exit Sub  

Err_Execute:  
MsgBox "An error occurred."  

End Sub 

Solution


Assuming that column H does not have any blank cells so it will be used to stop the loop:


Private Sub CommandButton1_Click()  

Dim r  
r = Range("A65536").End(xlUp).Row  
Dim i  
Dim j  
j = 8  

Do While Not IsEmpty(Range("H" & j))  

If IsNumeric(Range("A" & j)) And Range("D" & j) = "" Then  
r = r + 1  
Range("A" & r) = Range("A" & j)  
Range("B" & r) = Range("B" & j)  
Range("C" & r) = Range("C" & j)  
Range("D" & r) = Range("D" & j)  
Range("E" & r) = Range("E" & j)  
Range("F" & r) = Range("F" & j)  
Range("G" & r) = Range("G" & j)  
End If  

j = j + 1  
Loop  

End Sub

Note that


Thanks to Helper for this tip on the forum.

Related


Published by aakai1056. Latest update on December 14, 2011 at 04:26 AM by aakai1056.
This document, titled "Excel - Copy a range if the a specific column is blank," is available under the Creative Commons license. Any copy, reuse, or modification of the content should be sufficiently credited to CCM (ccm.net).