Loop & unique value problems

[melewie]

Hello all,

I am having problems trying to figure out how to do a loop in excel that copys rows to another sheet if the is a blank cell in the row. The problem I am having is some rows have more than one blank cell so it is creating duplicates, column A has unique values but having issues building this into a loop the code I am using is.

NumRows = Cells(65000, 1).End(xlUp).Row 'count number of rows to look at on raw data sheet
For ColNo = 1 To 46 ' start count column loop
For RowNo = 1 To NumRows 'start count row loop

If Cells(RowNo, ColNo).Value = "" And Cells(RowNo, 21).Value <> "External" Then

Cells(RowNo, ColNo).EntireRow.Copy
Worksheets("Missing Data").Select
Cells(65000, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Worksheets("Employee Data Report").Select

End If
Next RowNo 'next row loop
Next ColNo 'all rows completed move onto next column

Which works fine but is copying over the rows with more than one blank cell once for every blank cell.

any help would be great.

Thanks

 

[Richard Schollar]

Hi

So let me get this straight: you want to copy a row if that row (from column 1 up to 46) contains at least one blank cell?

If the cells are blank are they truly blank (ie don't contain anything) or do they contain formulas that result in "" (eg =IF(A1>5,"SomeValue",""))?

 

[melewie]

Hi

So let me get this straight: you want to copy a row if that row (from column 1 up to 46) contains at least one blank cell?

If the cells are blank are they truly blank (ie don't contain anything) or do they contain formulas that result in "" (eg =IF(A1>5,"SomeValue",""))?

you got it in one.
Yes they are blank nothing in them at all.

 

[Richard Schollar]

Hi

try this:

Sub copydata()
Dim wsFrom As Worksheet, wsTo As Worksheet
Dim lngCalc As Long
Dim rngData As Range

Set wsFrom = Worksheets("Employee Data")
Set wsTo = Worksheets("Missing Data")

Set rngData = wsFrom.UsedRange

wsTo.UsedRange.ClearContents  'you may want to comment this out as it will clear any and all pre-existing data on the Missing Data sheet


With Application
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

With wsFrom
    .AutoFilterMode = False
    With rngData
        .Resize(, 1).Offset(, .Columns.Count).FormulaR1C1 = "=columns(RC1:RC46)=COUNTA(RC1:RC46)"
        Set rngData = .Resize(, .Columns.Count + 1)  'imclude the new column of formulas
    End With
End With
With rngData
    .AutoFilter field:=.Columns.Count, Criteria1:=False
    .SpecialCells(xlCellTypeVisible).Copy
    With wsTo
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial
    End With
    .AutoFilter
    .Columns(.Columns.Count).ClearContents
End With

Application.Calculation = lngCalc

    

End Sub

Please take note of the code above in red and decide if you would like to remove it!!!

 

[melewie]

Cheers that does seem to work thank you.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I was ideally looking for a way to do this within the loop or within another loop.<o></o>
<o></o>
Don’t mean to sound ungrateful I do appreciate the help.

 

[Richard Schollar]

How many rows are you likely to have in the sheet? If it's anything above a couple of thousand then Autofilter is easily the fastest method you'll find.

But, for looping purposes, you only need to loop thru each row (not each cell in the 46 columns) and use a similar check to the one I was using:

For i = 1 to 65000
  If Application.WorksheetFunction.Counta(Range("A" & i).Resize(,46))<46 Then
    Range("A" & i).Resize(,46).Copy   'take it to the Missing sheet
   'code...
Next i

So what the above is doing is counting all the values in columns 1 to 46 in each row and if the count is lower than 46 (ie there is a blank cell within) then it is copying that row.

Make sense?