Macro to copy paste special ignoring formulas in cells

geminian

New Member
Joined
Jun 11, 2016
Messages
8
Hi,

Please can someone help me.

I have setup a workbook as follows:

Receipt Page which creates a table of data based on input data.
This creates a maximum possible range to copy of A2:I20
every cell in this range contains formulas although some may return a blank cell eg. (=IF(B3<>"",B3,""))

My macro then selects this range and copies it to the 'Data' sheet and paste values it on to the next available row.
It does work apart from copying the blank rows as well (As the range states)

The 'Data' sheet has a formula in column A that converts the date (first cell of the pasted data) into a calendar month, hence the offset in my code.

I thought I had got around this by doing a sort at the end of the pasting, only to realise down the line that these rows are being pushed to the end of the data and are not treated the same as truly blank rows.

i need it to only copy the rows that have values and not formulas,


Summary of actions

Person inputs sales info into a receipt template which is printed out and given to customer (Could be 1 to 20 items on different lines)
Relevant Data is taken from this and arranged in a table via formula which tidies it up
Macro copies table and pastes it into Data sheet which is a record of all transactions
Macro then sorts Data by date (in the hope of removing blank rows copied over)
Macro then clears the sales data from the receipt template
Macro then moves the receipt number on 1

I hope I've given enough info for someone to be able to help me as I've spent untold hours on this and am feeling rather fed up now.

See Code

' Macro1 Macro
'


'


Sheets("Receipt").Range("O14:AB31").Copy
Sheets("Data").Range("A5000").End(xlUp).Offset(1, 1).PasteSpecial _
Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Data").Select
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("A:O").Select
ActiveWorkbook.Worksheets("Data").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Data").Sort.SortFields.Add Key:=Range("C2:C5000") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Data").Sort
.SetRange Range("A1:O5000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
Range("A1").Select
Sheets("Receipt").Select
Range("E11").Select
Selection.ClearContents
Range("g11").Select
Selection.ClearContents
Range("E8:J10").Select
Selection.ClearContents
Range("B14:B31").Select
Selection.ClearContents
Range("H14:H30").Select
Selection.ClearContents
Range("g35:G35").Select
Selection.ClearContents
Range("d29:d30").Select
Selection.ClearContents
Range("k29:k30").Select
Selection.ClearContents
Range("H31").Select
Selection.ClearContents
Range("L8").Select
ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 + 1
Range("A1").Select
ThisWorkbook.Save
End With



End Sub
 
Okay Mark,

As Im trying to do away with the requirement to sort I've been playing and I think it should go something like this (See Below) which I've got off the internet, I just cant get it to work, I'm also led to believe 'Special Cells could be an answer but I've no experience:

Sub macro1()
Dim mySheet As Worksheet, myOtherSheet As Worksheet, myBook As Workbook 'Define your workbooks and worksheets as variables
Set myBook = Excel.ActiveWorkbook
Set mySheet = myBook.Sheets("sheet1")
Set myOtherSheet = myBook.Sheets("Sheet2")


Dim i As Integer, j As Integer 'Define a couple integer variables for counting


j = 2
'This variable will keep track of which row we're on in Sheet2 (I'm assuming you want to start on line 2)
For i = 5 To 20
'This is the beginning the the loop which will repeat from 5 to 100 . . .
If mySheet.Cells(i, 1).Value <> "" Then
' . . . for each digit, it will check if the cell's value is blank. If it isn't then it will . . .
myOtherSheet.Cells(j, 2).Value = mySheet.Cells(i, 1).Value
' . . . Copy that value into the cell on Sheet2 in the row specified by our "j" variable.
j = j + 1
'Then we add one to the "j" variable so the next time it copies, we will be on the next available row in Sheet2.
End If
Next i
'This triggers the end of the loop and moves on to the next value of "i".


End Sub
 
Upvote 0

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
@geminian

Try the code below then your cells that appear blank in column O should be genuine blank cells.

Code:
Sub CleanCells()
    Dim rng As Range, cell As Range
    Set rng = Worksheets("Data").Columns("O").SpecialCells(xlCellTypeConstants)

    For Each cell In rng.Cells
        cell.Value = Application.WorksheetFunction.Clean(Trim(cell.Value))
    Next cell
End Sub

then you should be able to filter for the non blank cells and then copy the visible cells.
 
Last edited:
Upvote 0
That didnt work arrghh

[TABLE="width: 971"]
<colgroup><col><col><col span="13"></colgroup><tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: center"][/TD]
[TD][/TD]
[TD]

[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
What happens if you run the code below?

Code:
Sub CleanCells()
    Dim rng As Range, cell As Range
    
    With Worksheets("Data").Range("O1:O" & Worksheets("Data").Range("O" & Rows.Count).End(xlUp).Row)
        Set rng = .SpecialCells(xlCellTypeConstants)

        For Each cell In rng.Cells
            cell.Value = Application.WorksheetFunction.Clean(Trim(cell.Value))
        Next cell
        
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "mySht"
        
        .AutoFilter Field:=1, Criteria1:="<>"

        On Error Resume Next
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Copy _
                Sheets("mySht").Range("A1")
        On Error GoTo 0
        .AutoFilter

    End With

End Sub


Btw
That didnt work arrghh
Tells me nothing
 
Upvote 0
Cracked it Mark, thankyou

Its a different solution to only selecting the cells with true values in to copy but it (Clean Cells) works.
I can now do away with the sort.

Many Thanks

Sub Macro1()
'
' Macro1 Macro
'


'


Dim NextRow As Range
With Sheets("Data")
Set NextRow = .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0)
End With
Sheets("Receipt").Range("o14:ab31").Copy
NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
Application.CutCopyMode = False
Set NextRow = Nothing

Dim rng As Range, cell As Range
Set rng = Worksheets("Data").Columns("B").SpecialCells(xlCellTypeConstants)


For Each cell In rng.Cells
cell.Value = Application.WorksheetFunction.Clean(Trim(cell.Value))
Next cell



End Sub
 
Last edited:
Upvote 0
Happy you got it Sorted (even if you are cleaning a different range now :eeek:).
 
Last edited:
Upvote 0
for the record, oldbrewer is a he......I admit I did not test my assertion but I will do later today
 
Upvote 0
Happy you got it Sorted (even if you are cleaning a different range now :eeek:).


I didn't want to delete the formulas or clean cells in the paste 'from' range which is what the 'clean cell' instructions were going to do (eg column O) prior to selecting and copying, as I would have had to write the formulas back in every time.
The data that was giving me the problem was on the paste 'to' sheet, maybe I didn't explain well enough, sorry

The workbook creates a set of accounts and reconciles cash for my friends hobby business.
If the code could be written any better which I'm sure it could as I'm not good with VBA and someone is willing to look at it for me, I could email it.

Thankyou
 
Upvote 0

Forum statistics

Threads
1,223,276
Messages
6,171,138
Members
452,381
Latest member
Nova88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top