vba code to copy all cells in a variable range

A

andycreber

Board Regular
Joined
May 20, 2010
Messages
74
Office Version
  1. 2016
Hi all

I have the following code in bold are copying cells that return data in formula after cell I4, but it is copying cells with a formula in it even if the formula is not returning any data, so visually the cells appear to be blank. IE my has to go down to 25 rows but in various cases the copied data may only apply to 5 rows.

It there a way to only copy the returned data in the formula? IE 5 rows without removing the formulas on the source sheet for the blank data

Reason being when I paste special values in the "Dump" sheet it is not finding the last true blank cell, its finding the whole copied range IE 20 rows so when this happens with multiple sheets there are blank rows in my data that cannot be sorted to align the rows.

All help would be greatly appreciated

thanks MR Excel helpers


Sheets("FL").Select
Range("I4").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Dump").Select
Range("B5000").End(xlUp).Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 
Sort by date Sort by votes
sorry, its been a long day:eeek:

there are no blank cells in columns B&C that don't need removing

cheers :biggrin:
 
Upvote 0

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Try running the code below

Code: 
Sub DelBC()
    On Error Resume Next
    Sheets("Dump").Range("B:C").SpecialCells(4).Delete xlUp
    On Error GoTo 0
End Sub
 
Upvote 0
that brought it into line

THANK YOU

how do i put it all together? bearing in mind I have to add more of the original codes for the next 20 sheets.

thanks mate
 
Upvote 0
andycreber said:
that brought it into line

THANK YOU

how do i put it all together? bearing in mind I have to add more of the original codes for the next 20 sheets.

thanks mate
Click to expand...

Depends if you have any blank cells in the other columns that can't be removed.
 
Upvote 0
i don't have any blank cells in any other columns that i need to use

I am only bringing in data for columns A,B,C,F & G

column E has a formula in it

so i think its ok
 
Upvote 0
andycreber said:
so i think its ok
Click to expand...

If you only think it is ok make sure that you test thoroughly on a copy of your workbook before using on the actual workbook as you are deleting cells (and there is no undo stack).
Other than that just run or call the macro below after doing all your copies.

Btw, if you are doing exactly the same actions with your copy code on all the worksheets then you should look at looping through the worksheets rather than writing code for each, but that is another question and there are plenty of examples online.

Code: 
Sub Trimit2()
    Dim myCell As Range, myRng As Range

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

    Set myRng = Sheets("Dump").Cells

    With myRng
        .Replace What:=Chr(160), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(13) & Chr(10), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(13), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(21), Replacement:=Chr(32), LookAt:=xlPart

        .Replace What:=Chr(8), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(9), Replacement:=Chr(32), LookAt:=xlPart
    End With

    On Error Resume Next
    For Each myCell In Intersect(myRng, _
                                 myRng.SpecialCells(xlConstants, xlTextValues))
        myCell.Value = Application.Trim(myCell.Value)
    On Error GoTo 0
    Next myCell

    On Error Resume Next
    Sheets("Dump").Cells.SpecialCells(4).Delete xlUp
    On Error GoTo 0

    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub
 
Upvote 0
MARK858 said:
If you only think it is ok make sure that you test thoroughly on a copy of your workbook before using on the actual workbook as you are deleting cells (and there is no undo stack).
Other than that just run or call the macro below after doing all your copies.

Btw, if you are doing exactly the same actions with your copy code on all the worksheets then you should look at looping through the worksheets rather than writing code for each, but that is another question and there are plenty of examples online.

Code: 
Sub Trimit2()
    Dim myCell As Range, myRng As Range

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

    Set myRng = Sheets("Dump").Cells

    With myRng
        .Replace What:=Chr(160), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(13) & Chr(10), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(13), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(21), Replacement:=Chr(32), LookAt:=xlPart

        .Replace What:=Chr(8), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(9), Replacement:=Chr(32), LookAt:=xlPart
    End With

    On Error Resume Next
    For Each myCell In Intersect(myRng, _
                                 myRng.SpecialCells(xlConstants, xlTextValues))
        myCell.Value = Application.Trim(myCell.Value)
    On Error GoTo 0
    Next myCell

    On Error Resume Next
    Sheets("Dump").Cells.SpecialCells(4).Delete xlUp
    On Error GoTo 0

    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub
Click to expand...


I put the code at the bottom of my code, ran it and it did not delete the blank cells. Do I need to put the =isblank formula bank in? As I took it out? thanks
 
Last edited:
Upvote 0
It shouldn't make any difference but what happens with the below ran separately?

Code: 
Sub Trimit2b()
    Dim myCell As Range, myRng As Range

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

    Set myRng = Sheets("Dump").Cells

    With myRng
        .Replace What:=Chr(160), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(13) & Chr(10), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(13), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(21), Replacement:=Chr(32), LookAt:=xlPart

        .Replace What:=Chr(8), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(9), Replacement:=Chr(32), LookAt:=xlPart
    End With

    On Error Resume Next
    For Each myCell In Intersect(myRng, _
                                 myRng.SpecialCells(xlConstants, xlTextValues))
        myCell.Value = Application.Trim(myCell.Value)
    Next myCell
    On Error GoTo 0
    

    On Error Resume Next
    Sheets("Dump").Cells.SpecialCells(4).Delete xlUp
    On Error GoTo 0

    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub
 
Last edited:
Upvote 0
MARK858 said:
It shouldn't make any difference but what happens with the below ran separately?

Code: 
Sub Trimit2b()
    Dim myCell As Range, myRng As Range

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

    Set myRng = Sheets("Dump").Cells

    With myRng
        .Replace What:=Chr(160), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(13) & Chr(10), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(13), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(21), Replacement:=Chr(32), LookAt:=xlPart

        .Replace What:=Chr(8), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(9), Replacement:=Chr(32), LookAt:=xlPart
    End With

    On Error Resume Next
    For Each myCell In Intersect(myRng, _
                                 myRng.SpecialCells(xlConstants, xlTextValues))
        myCell.Value = Application.Trim(myCell.Value)
    Next myCell
    On Error GoTo 0
    

    On Error Resume Next
    Sheets("Dump").Cells.SpecialCells(4).Delete xlUp
    On Error GoTo 0

    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub
Click to expand...


Nothing happend !
 
Upvote 0
I ran this code before and after my other code and nothing happened. Sorry about this, did I do something wrong in this? Thanks for your constant help.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Dynamic Address by VBA
Replies
8
Views
152
MikeVol
MikeVol
J
  • Question Question
VBA - Copy Data Range without giving exact location to another sheet
Replies
1
Views
211
Anthony47
A
I
  • Question Question
Filter column on text value if that value exists using VBA
Replies
7
Views
278
Peter_SSs
Peter_SSs
Y
  • Question Question
Copy data to another sheet last row
Replies
1
Views
532
Joe4
Joe4
excelbytes
  • Solved
VBA Code To Copy Data Into Next Blank Column
Replies
5
Views
573
mumps
mumps

Forum statistics

Threads
1,223,912
Messages
6,175,340
Members
452,638
Latest member
Oluwabukunmi

Share this page

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