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

December 2016




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 :

This document entitled « Excel - Copy a range if the a specific column is blank » from CCM (ccm.net) is made available under the Creative Commons license. You can copy, modify copies of this page, under the conditions stipulated by the license, as this note appears clearly.