Copying values skipping blanks

J

justaguyfromky

I have a macro that is supposed to create an order form based on our current
inventory. I use a script that I got help on from this forum. When I run
this macro, sometimes it works, (It is supposed to copy a cell value created
from a formula and place it into another column skipping all blank cells)
Sometimes it copies the formula in the cell instead of the value.

What would I need to change to get it to copy only the VALUE to the new cell?

Macro example below:

Sub OfficeDepotDB()

Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim StartRow As Long
Dim EndRow As Long
Dim rng As Range

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

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

With ActiveSheet
..DisplayPageBreaks = False
StartRow = 1
EndRow = 50

For Lrow = StartRow To EndRow Step 1

If IsError(.Cells(Lrow, "K").Value) Then
'Do nothing, This avoid a error if there is a error in the cell

ElseIf .Cells(Lrow, "K").Value <> "" Then
If rng Is Nothing Then
Set rng = .Cells(Lrow, "K")
Else
Set rng = Application.Union(rng, .Cells(Lrow, "K"))
End If
End If

Next
End With

If Not rng Is Nothing Then rng.Copy Range("L3")

ActiveWindow.View = ViewMode
With Application
..ScreenUpdating = True
..Calculation = CalcMode
End With

End Sub
 
T

Tom Ogilvy

Sub OfficeDepotDB()

Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim StartRow As Long
Dim EndRow As Long
Dim rng As Range

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

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

With ActiveSheet
..DisplayPageBreaks = False
StartRow = 1
EndRow = 50

For Lrow = StartRow To EndRow Step 1

If IsError(.Cells(Lrow, "K").Value) Then
'Do nothing, This avoid a error if there is a error in the cell

ElseIf .Cells(Lrow, "K").Value <> "" Then
If rng Is Nothing Then
Set rng = .Cells(Lrow, "K")
Else
Set rng = Application.Union(rng, .Cells(Lrow, "K"))
End If
End If

Next
End With

If Not rng Is Nothing Then
rng.copy
Range("L3").PasteSpecial xlPasteValues
End if

ActiveWindow.View = ViewMode
With Application
..ScreenUpdating = True
..Calculation = CalcMode
End With

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top