Copy (removing blank cells) without clipboard

[scottzuehl]

Is it possible to copy a column (or range) of data, remove all the
blank cells and paste the results into another column (or range)
without using the clipboard?

So far I am using the following, but I am trying to avoid the clipboard
to save time.

Application.ScreenUpdating = False
Range("S5:S2000,T5:T2000").ClearContents
Range("Q5:Q2000,R5:R2000").SpecialCells(xlCellTypeFormulas, 1).Copy
Range("S5:T5").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.Calculate
Application.ScreenUpdating = True


thanks in advance

 

[Tom Ogilvy]

Dim rng as Range
Dim s as Long, t as Long
Dim cell as Range
set rng = Range("Q5:R2000").SpecialCells(xlFormulas,1)
for each cell in rng
if cell.Column = 17 then
s = s + 1
cells(s,"S").Value = cell.Value
else
t = t + 1
cells(t,"T").Value = cell.value
end if
Next

If I know more about what is in the source columns, there might be quicker
ways. For example, if the specialcells will pick up every non empty cell,
then you could equate the areas then select with specialcells for blanks and
delete those cells.

 

[scottzuehl]

Thx Tom

The source column contains formulas. The formulas result in either a
number or a blank cell. Here is an example of the source cell formula:

=IF(ISNUMBER(M6),IF(OR(AND(M6>0,M5<0),AND(M6<0,M5>0)),E5,""),"")

I'm giving your response a try. If you think there is a more efficient
method please feel free.

 

[scottzuehl]

I've implemented your recommendation. I was surprised that it was
slower than using the clipboard. I think it can be speeded up. Here's
my idea. The source data range is Q5:R2000. Whenever there is a value
in column Q there is also a value in column R. For example, if there
is a value in Q5 then there is also a value in R5. Both these values
need to be copied to S5 and T5 respectively. Is it possible check for
the existance of a value in column Q and then paste the values from
columns Q and R to S and T? (It also has to remove the blank cells
from columns Q and R (as it does in you suggestion above)). If this is
possible then it only has to loop through 1/2 of the cells instead of
all the cells.

thx for your help.

 

[Tom Ogilvy]

Dim rng as Range
Range("S5:T2000").Value = Range("Q5:R2000").Value
On Error Resume Next
set rng = Range("S5:S2000").SpecialCells(xlConstants,xlTextValues)
On Error goto 0
if not rng is nothing then
rng.Delete Shift:=xlShiftUp
End if

Would work I would think.

 

[Tom Ogilvy]

You can try my other suggestion, but here is a refinement of the first.

Dim rng as Range
Dim s as Long
Dim cell as Range
s = 5
set rng = Range("Q5:Q2000").SpecialCells(xlFormulas,1)
for each cell in rng
cells(s,"S").Resize(1,2).Value = _
cell.Resize(1,2).Value
s = s + 1
Next

 

[scottzuehl]

Thx for all your help Tom....I appreciate it.

I've tried the 2nd suggestion above but it does not work (the xlshiftUp
one). It copies the range correctly but does not remove the blank
cells. I tried something similar using the macro recorder. It will do
the job but I have formulas that refer to the destination cells. After
the xlshiftup process the formulas have #REF! where the cell locations
use to be.

Overall I still cannot beat the spead of the copy/paste method using
the clipboard. Your last suggestion comes the closest as far as
beating the clipboard.

 

[Tom Ogilvy]

This should be faster

Sub abc()
Dim rng As Range
Dim s As Long
Dim cell As Range
v = Range("Q5:R2000").Value
j = 1
For i = LBound(v, 1) To UBound(v, 1)
If IsNumeric(v(i, 1)) Then
v(j, 1) = v(i, 1)
v(j, 2) = v(i, 2)
j = j + 1
End If
Next
Range("T5").Resize(j - 1, 2).Value = v

End Sub

 

[scottzuehl]

Thank you so much for your help Tom. Yes you are right...this last
procedure is faster. No longer is this piece of code the bottleneck in
the app. Thx again sharing your experience and the help you provided.