I have created a tool in excel which can take two spreadsheets, and copy the content from one to another when we do an update on the sheet itself.
The tool is purely designed to be a copy / paste tool, the current code will copy and paste values from sheet to sheet.
I have to include logic into the tool to skip cells with formulas, if the tool copies and pastes the formulas which are currently in the source sheet to the target sheet, they no longer match and throw #REF errors. Any suggestions on how to put a for loop in here or something similar to allow it to check and ignore cells with formulas? I need it only to copy / paste cells with numbers or values.
Sub CopyWorkbook()
Dim wb1 As Workbook, wb2 As Workbook
wb1.Sheets("Capex").Range("H1124:AT1173").Copy
wb2.Sheets("Capex").Range("H529:AT578").PasteSpecial Paste:=xlPasteAll
wb1.Sheets("Capex").Range("H1275:AT1284").Copy
wb2.Sheets("Capex").Range("H580:AT589").PasteSpecial Paste:=xlPasteAll
Rather than loop cell by cell you can use SpecialCells to identify the formulae
There are two options
Copy only the Constant cells to the destination
Remove any Formula cells from the destination
If your formulae occur in a single contigious block then (1) works easily, else this will result in a number of areas needing to copied over. So (2) is preferable
Your first range can be covered as so.
Dim rng1 As Range
Set rng1 = Range("H1124:AT1173")
rng1.Copy [h1275]
On Error Resume Next
[h1275].Resize(rng1.Rows.Count, rng1.Columns.Count).SpecialCells(xlFormulas) = vbNullString
On Error GoTo 0
If you really want to skip cells containing formulas, you could use this example as a start.
The code assumes that only formulas start with an equals sign.
Edit: expanding the example with the ranges in the question.
Sub example()
Dim source As Range
Dim target As Range
Set source = ActiveSheet.Range("A1:B6")
Set target = ActiveSheet.Range("D1:E6")
copy_non_formulas source:=source, target:=target
'Extended example using the ranges posted in the question
'For the sake of formatting, I omitted the fully qualified
'range names.
copy_non_formulas source:=Range("H1124:AT1173"), target:=Range("H529:AT578")
copy_non_formulas source:=Range("H1275:AT1284"), target:=Range("H580:AT589")
End Sub
Public Sub copy_non_formulas(source As Range, target As Range)
'Assumes that all formulas start with '=' and all non formulas do not
Dim i As Long
Dim j As Long
Dim c As Range
For i = 1 To source.Rows.Count
For j = 1 To source.Columns.Count
Set c = source(RowIndex:=i, ColumnIndex:=j)
If Left(c.Formula, 1) <> "=" Then
target(RowIndex:=i, ColumnIndex:=j).Value = c.Value
End If
Next j
Next i
End Sub
Can't you just use Paste:=xlPasteValues for all cells? That way no formulas get copied to the target sheet.
Related
I came across this link in the forum
VBA Remove format from empty cells in Excel
However, I would like to clear the formatting of empty cells, ignoring the merged cells.
This should do the trick. You will need to make two updates here:
Update the sheet name in code to the sheet of interest
Update the range in code to the relevant range you want this code to work on (for testing purposes, the range is currently set to ws.Range("A1:A30"))
The macro will loop trough each cell in the provided range (which you need to update per #2) and will check to see if the cell is both empty AND unmerged. If the cell meets this criteria, we will add it to a range variable (Format_Range) and continue the loop. Once the loop is complete, clear the formatting of the variable range all at once.
Sub Custom_Format()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") 'Update Sheet Name
Dim Target As Range, Format_Range As Range
For Each Target In ws.Range("A1:A30") 'Update Range to run macro on
If Target.MergeCells = False And Target = "" Then
If Not Format_Range Is Nothing Then
Set Format_Range = Union(Target, Format_Range)
Else
Set Format_Range = Target
End If
End If
Next Target
'Make sure the range is not empty before removing format
If Not Format_Range is Nothing Then Format_Range.ClearFormats
End Sub
Sample Output
Here is a before (Column A) and after (Column B) photo when using the macro. Note that all unmerged cells had the formatting stripped from them when they were blank while merged cells kept their formatting regardless.
you could use SpecialCells property of Range object and get all blank cells on which testing if they are part of a merged area:
Dim cel As Range
With ActiveSheet ' <- change this to your actual sheet reference of interest
With .UsedRange ' <- change this to your actual range reference of interest
For Each cel In .SpecialCells(XlCellType.xlCellTypeBlanks).Cells
If Not cel.MergeCells Then Debug.Print cel.ClearFormats
Next
End With
End With
I have a budgeting worksheet that contains multiple sheets and formulas. A user can enter his data into the ledger, and various financial scenarios are automatically calculated. The ledger contains some cells that contain formulas, and may be over-written by the user. That is fine since the worksheet is projecting month per month, and must be updated with actual entries to keep the projections accurate.
Occasionally I update/upgrade the budgeting worksheet, and want the user to be able to export his data from the old worksheet and import it to the new worksheet. I have created a macro that exports the data for certain ranges. I have also created a macro that imports the data range to the new worksheet.
However, my problem is that the macro to export also converts predetermined calculations from their original formula (=A1+B2, for example) to whatever the result is for that formula ($1,200, for example). This causes problems for future projections in other data ranges since the formula is now replaced with a static number that cannot change based upon other monthly deposits/withdrawals.
I have tried exporting the data minus any cells that contain formulas but have been unsuccessful. I have attached my working export code (as I have many sheets and ranges, I have only posted the minimum to show what I have working). I have also attached the code I used for ignoring cells with formulas (inspired by this post Excel VBA Copy / Paste macro: Ignore cells with Formulas).
Any help is greatly appreciated. As is surely obvious, I am new to VBA and know next to nothing about it!
WORKING EXPORT CODE:
Sub GenerateData()
Dim strFile As String
'New workbook with 3 sheets
Workbooks.Add xlWBATWorksheet
ActiveSheet.Name = "Financial Info"
Sheets.Add(After:=Sheets(1)).Name = "HELOC"
Sheets.Add(After:=Sheets(2)).Name = "Accelerated Mortgage"
Sheets.Add(After:=Sheets(3)).Name = "Accelerated 2nd Loan"
ActiveWorkbook.Sheets("Financial Info").Range("G6:G8").Value = ThisWorkbook.Sheets("Financial Info").Range("G6:G8").Value
ActiveWorkbook.Sheets("Financial Info").Range("G11:G13").Value = ThisWorkbook.Sheets("Financial Info").Range("G11:G13").Value
ActiveWorkbook.Sheets("HELOC").Range("D13:F74").Value = ThisWorkbook.Sheets("HELOC").Range("D13:F74").Value
ActiveWorkbook.Sheets("HELOC").Range("D86:F147").Value = ThisWorkbook.Sheets("HELOC").Range("D86:F147").Value
End Sub
NON-WORKING:IGNORE CELLS WITH FORMULA
Sub example()
Dim source As Range
Dim target As Range
Set source = ActiveWorkbook.Sheets("HELOC").Range("D13:F877")
Set target = ThisWorkbook.Sheets("HELOC").Range("D13:F877")
copy_non_formulas source:=source, target:=target
copy_non_formulas source:=Range("D13:F74"), target:=Range("D13:F74")
copy_non_formulas source:=Range("D86:F147"), target:=Range("D86:F147")
End Sub
Public Sub copy_non_formulas(source As Range, target As Range)
'Assumes that all formulas start with '=' and all non formulas do not
Dim i As Long
Dim j As Long
Dim c As Range
For i = 1 To source.Rows.Count
For j = 1 To source.Columns.Count
Set c = source(RowIndex:=i, ColumnIndex:=j)
If Left(c.Formula, 1) <> "=" Then
target(RowIndex:=i, ColumnIndex:=j).Value = c.Value
End If
Next j
Next i
End Sub
Here is a simple subroutine which moves only constant values from Sheet1 to a new workbook.
It should be simple to edit this to your requirements, but let me know if you have any problems.
Sub CopyWithoutFormulas()
Dim newWorkbook As Workbook
Set newWorkbook = Workbooks.Add
Dim formulas As Range
On Error Resume Next
Set formulas = Sheet1.UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If formulas Is Nothing Then
'no formulas so move all values across in one batch
newWorkbook.Worksheets(1).Range(Sheet1.UsedRange.Address).Value = Sheet1.UsedRange.Value
Else
'formulas found so only move constants across
Dim r As Range
For Each r In Sheet1.UsedRange
If Intersect(r, formulas) Is Nothing Then
newWorkbook.Worksheets(1).Range(r.Address).Value = r.Value
End If
Next
End If
End Sub
I tried your code and it seems to work just fine. How does it fail, on what data?
You are in fact copying values from a range and pasting them to the same range, so there is no way of knowing whether it worked. Try to update these lines, set source and target to different ranges. For example, instead
copy_non_formulas source:=Range("D13:F74"), target:=Range("D13:F74")
copy_non_formulas source:=Range("D86:F147"), target:=Range("D86:F147")
you could try
copy_non_formulas source:=Sheets(1).Range("D13:F74"), target:=Sheets(2).Range("D13:F74")
copy_non_formulas source:=Sheets(1).Range("D86:F147"), target:=Sheets(2).Range("D86:F147")
I have tried several suggestions from this site, as well others, but since I am not really sure how to write code in the first place, I am getting nowhere. For the record, the code I posted as "working" I tweaked from an online source and it does exactly what I want...except it copies cells with formulas. The "working" code creates a new workbook with the same tabs, and exports the data to the same respective cells. Now if only I can edit my existing "working" code to eliminate the copying of cells with formulas? For reference here is the full "working" code minus all the sheets/data ranges.
Sub GenerateData()
Dim strFile As String
'New workbook with 3 sheets
Workbooks.Add xlWBATWorksheet
ActiveSheet.Name = "Financial Info"
Sheets.Add(After:=Sheets(1)).Name = "HELOC"
Sheets.Add(After:=Sheets(2)).Name = "Accelerated Mortgage"
Sheets.Add(After:=Sheets(3)).Name = "Accelerated 2nd Loan"
ActiveWorkbook.Sheets("Financial Info").Range("G6:G8").Value = ThisWorkbook.Sheets("Financial Info").Range("G6:G8").Value
ActiveWorkbook.Sheets("Financial Info").Range("G11:G13").Value = ThisWorkbook.Sheets("Financial Info").Range("G11:G13").Value
ActiveWorkbook.Sheets("HELOC").Range("D13:F74").Value = ThisWorkbook.Sheets("HELOC").Range("D13:F74").Value
ActiveWorkbook.Sheets("HELOC").Range("D86:F147").Value = ThisWorkbook.Sheets("HELOC").Range("D86:F147").Value
ActiveWorkbook.SaveAs "Exported Data.xlsx"
End Sub
So I have a big excel sheet with a bunch of empty cells in various locations. I want an easy to work with list of which cells are empty. I was hoping to make a new worksheet that was populated with the locations of the empty cells. I wanted to have this to just populate the cells I want it to. I kept the header from the worksheet I will be checking and added a blank cells count, so I want the following cells in the column to be populated by the list of empty cell locations.
Now I know I can use =ISBLANK to test if a cell is empty or not, but I only care about the cells that return TRUE. So I figure I'll need a loop. And I want the location of the cell so I can use =CELL. And to make this most readable I want to do this on a column by column basis.
But I want to populate a spreadsheet with this information in a manner similar to how functions work (I just want to copy and paste it to other cells and columns). But it's pretty clear that I am going to need VBA.
My question is how can I create a macro to populate my spreadsheet with a list of empty cells? How do I apply it to the cells?
I assume you have data in sheet1, I have used sample range// Range("A1:c15") however you can define range as per need and blank cells address will be published in next sheet.
Sub FindBlank()
Dim rng As Range
dim i as long
For Each rng In Sheet1.Range("A1:c15").SpecialCells(xlCellTypeBlanks)
i = i + 1
Sheet2.Cells(i, 1) = rng.Address
Next
End Sub
If you want a list of the cells that are empty, you can use Range().SpecialCells(xlCellTypeBlank):
Sub getEmptyCellAddresses()
Dim rng As Range
Dim ws as Worksheet
Set ws = Sheets("Sheet1") ' CHANGE AS NECESSARY
Set rng = ws.Range("A1:A15").SpecialCells(xlCellTypeBlanks) ' Edit/change range as necessary
ws.Cells(1, 2).Value = rng.Cells.Address ' Change `ws.cells(1, 2)` to whatever destination you like
End Sub
Edit: Ah, beaten by 16 seconds by #RamAnuragi ...but anyways, they're slightly different ways to tackle the question so I'll leave it.
Edit: For funsies, here's another way to put them all in a column, one row per cell...and more, per your comments.
Sub listEmptyCells()
Dim emptyAddresses() As String
Dim i As Long
Dim ws As Worksheet
Dim rng As Range
Set ws = Sheets("Sheet1") ' CHANGE AS NECESSARY
Set rng = ws.Range("A1:A15")
If WorksheetFunction.CountBlank(rng) = 0 Then
MsgBox ("No empty cells in the range")
Exit Sub
End If
emptyAddresses() = Split(rng.SpecialCells(xlCellTypeBlanks).Address, ",")
For i = LBound(emptyAddresses) To UBound(emptyAddresses)
ws.Cells(i + 1, 2).Value = emptyAddresses(i)
Next i
End Sub
How can i modify the code below to select data from any worksheets and copy they to another worksheet for example select and copy data from Worksheets("uno") and paste they to Worksheets("duo"). Because the code below selects data only on activesheet
Set tbl = ActiveCell.CurrentRegion
tbl.Resize(tbl.Rows.Count, tbl.Columns.Count).Select
I have a code to copy data from any sheet to another for example
Worksheets("uno").Range("A5:T5,A7:T56,W5,Y5,W7:W56,Y7:Y56").Copy _
Worksheets("duo").Range("B4")
But i want to copy a range with data and ignore blank cells because the range A5:T5 it doesn't have always all cells with data concretely the last cells of this range, two or three of those, and also the same on range A7:T56.
My problem is how to select a range with data and ignore the blank cells inside the range A7:T56 concretely the last rows and the last columns which haves blank cells
Well, for the first part, where "the code selects data only on the activesheet", you just need to activate the correct sheet (for example: "Worksheets("uno").Activate") before executing "Set tbl = ActiveCell.CurrentRegion".
I am not really sure if I understand you correctly, but these are my thoughts:
If you don't want to activate worksheet "uno" you need to create a reference to that worksheet to have a direct access to it:
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Set wkb = Excel.Application.Workbooks("<name of your workbook>")
Set wks = wkb.Worksheets("uno")
If you now use the following code:
wks.Range("<your range>").Copy
you have just copied your selected cells, now you can paste it wherever you want.
As for the part with avoiding empty cells:
Generally speaking, you need to create a method of checking whether relevant cells are empty or not before you add them to your range.
Personally, I would avoid trying to copy the whole range as such. Instead I would:
1) loop through all relevant cells in your range one by one
2) for each cell check if it's empty
3) if empty, go to next cell
4) if not empty, copy that cell and paste to the target worksheet
5) jump to next relevant cell
6) when you reach the cell which is just after your last cell, quit looping
I would use the above defined wks object.
Note that a Range object can be treated as a collection of strings, so you can iterate using For... Next loop (For Each loop does not guarantee the index order).
Something like this should do:
Dim rng As Range
Set rng = wks.Range("<your range>")
Dim numOfItems As Integer, itm, i As Integer
numOfItems = rng.Count
For i = 1 To numOfItems
itm = rng.item(i)
If itm <> "" Then
'set value of the corresponding cell in your target worksheet to itm
'<relevant cell>.Value = itm
Else
'do nothing
End If
Next i
I hope it's at least a little bit helpful.
I have a spreadsheet I'm using to compile text that changes all the time.
In column AD, Row 4(AD4) I put the contents of text, and it can have data going 1000 to 4000 rows down. It changes every time, so there is no static range name. I need a macro that
finds the final piece of data in that column,
then automatically "drags a box" from that spot two columns to the left (AB4)
and copies it... (A 3000 row piece of text would be AB4:AD3004) (Macro stops there, with text to be copied highlighted)
The current version finds the bottom cell correctly, but if I run the macro a 2nd time, with new data, it keeps trying to copy the same range. (I used the Formula Define.Name method, to name the cell, and then selected AB4:LastRow) but it is ALWAYS 3160 whether data goes to row 4000 or not.....
Sub Last_row()
Cells(Application.Rows.Count, 30).End(xlUp).Select
' following lines of code are useless
Range("AB4:AD3160").Select
Range("AD3160").Activate
Selection.Copy
End Sub
To answer your question directly:
With Sheet1
.Range("AB4", .Cells(Rows.Count, "AD").End(xlUp)).Copy
End With
Copy to specific location WITHOUT using clipboard:
With Sheet1
.Range("AB4", .Cells(Rows.Count, "AD").End(xlUp)).Copy Sheet2.[A1]
End With
Copy and exclude formatting:
With Sheet1
With .Range("AB4", .Cells(Rows.Count, "AD").End(xlUp))
Sheet2.Cells(1, "A").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End With
Note: Replace all sheet codenames (sheet1, Sheet2) above with your actual sheet codenames.
Your current code hard-codes the range of interest with
Range("AB4:AD3160").Select
This code will define a dynamic range starting from AB4 to the last non-empty cell in column AD
You can then use this range (without selecting) for changing values elsewhere (note that you may not need to actually copy rng1, it is possible to dump these values to a separate range directly without a copy and paste.
Sub Last_row()
Dim rng1 As Range
Set rng1 = Range([ab4], Cells(Rows.Count, 30).End(xlUp))
rng1.Copy
End Sub
Update: Example of how to copy a dynamic sized range from one sheet to another without a copy and paste:
Sub Last_row2()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
Set rng1 = ws1.Range(ws1.[ab4], ws1.Cells(Rows.Count, 30).End(xlUp))
ws2.[a1].Resize(rng1.Rows.Count, rng1.Columns.Count).Value = rng1.Value
End Sub