Macro to copy paste special ignoring formulas in cells

[geminian]

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

 

[geminian]

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

 

[MARK858]

@geminian

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

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.

 

[geminian]

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]

 

[MARK858]

What happens if you run the code below?

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

 

[geminian]

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

 

[MARK858]

Happy you got it Sorted (even if you are cleaning a different range now ).

 

[oldbrewer]

for the record, oldbrewer is a he......I admit I did not test my assertion but I will do later today

 

[geminian]

Happy you got it Sorted (even if you are cleaning a different range now ).

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