How to calculate the used cell range of an Excel 2007 file - excel-2007

Kindly let us know how to calculate the used cell range (i.e.,the cells that contain some data) for a given Excel 2007 or Excel 2010 file.
Thanks and Regards,
Sharpsubbu

To count the number of used cells on a worksheet use:
Sub HowManyUsedCells()
Dim total As Long
With ActiveSheet.Cells
On Error Resume Next
total = .SpecialCells(xlConstants).Count
total = total + .SpecialCells(xlFormulas).Count
On Error GoTo 0
End With
MsgBox total
End Sub
To locate the used cells on a worksheet, this:
Sub WhereAreTheUsedCells()
MsgBox ActiveSheet.UsedRange.Cells.Address
End Sub
will work most of the time.

Related

VBA Alert pop up for values in a column

I'm trying to create a VBA -Alert pop up in a excel column.
In the excel sheet based on certain calculation some Growth% (column H) will be calculated and if the Growth% > 20%, a alert popup would be generated asking for the Reason Code, which needs to be put in Column I.
The code is working fine for a particular cell (say H7) but when I'm extending it for a range (say H7:H700), it's not working.
Can someone please assist me regarding this.
The code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("H7:H700") > 0.2 Then
MsgBox "GR% >20%, Put the reason code"
End If
End Sub
% growth Reason Code
34%
20%
18%
The updated snapshot of the excel sheet:
Now the ASM/RSM can update their forecast and automatically Growth % will be calculated in column H ...the same values will be copied in column I (as paste special) and if the Growth % > 20% , then the alert will pop up...
The code I'm using ( with kind help of JC Guidicelli):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xCell As Range, Rg As Range
On Error Resume Next
Sheets("Sheet1").Range("H7:H700").Copy
Sheets("Sheet1").Range("I7:I700").PasteSpecial xlPasteValues
Set Rg = Application.Intersect(Target, Range("I7:I700"))
If Not Rg Is Nothing Then
For Each xCell In Rg
If xCell.Value > 0.2 Then
xCell.Select
MsgBox "GR% >20%, Put the reason code"
Exit Sub
End If
Next
End If
End Sub
The issue is for the calculation of Growth% < 20% , it's working fine...but for Growth% >20%, it's throwing the pop up but getting stuck..
Could someone please assist me regarding this..
EDIT:
When you add or paste value in your selected range, the message is showing ;)
Try and let me know, it's working for me :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xCell As Range, Rg As Range
On Error Resume Next
Set Rg = Application.Intersect(Target, Range("H7:H700"))
If Not Rg Is Nothing Then
For Each xCell In Rg
If xCell.Value > 0.2 Then
xCell.Select
MsgBox "GR% >20%, Put the reason code"
Exit Sub
End If
Next
End If
End Sub

Copy values across relative worksheets

I would like to copy a range of values from one worksheet into a specified range of another worksheet whereas values always come from the previous worksheet (in the worksheet row), even after duplicating the worksheet. I'm using the following to copy values from one worksheet to the other, which seems to work:
Sub Copy_ultimo_stock()
'copy values between two periods
Worksheets("Period2").Range("test3").Value = Worksheets("Period1").Range("test2").Value
End Sub
I had to give the range of cells a name (test2 and test3), because the macro wouldn't work if I use the actual cell range like "R10:S11". In the future however, I would just like to use the cell range as "R10:S11".
My actual problem however is the following. If I duplicate my worksheets in the future (for future periods), I want that I always copy the cell range from the previous worksheet. The way I have done it now, if I copy the worksheet period2, and call it maybe period6, it will still copy values from period1 worksheet. However, I would like that the current worksheet "n" will copy values from the range in worksheet "n-1".
I have found a somewhat similar approach that could help, but I couldn't combine both macros into one. That approach is here:
Function PrevSheet(rCell As Range)
Application.Volatile
Dim i As Integer
i = rCell.Cells(1).Parent.Index
PrevSheet = Sheets(i - 1).Range(rCell.Address)
End Function
EDIT
So you requirement is a macro that imports from "the previous sheet", so that when you click the button, the subroutine first fetches the previous from the current and accordingly fetches the values.
We will suppose that all Worksheets are named like "periodx", where x is an integer identifying the period. when we create a new worksheet copy, we need first to rename the new worksheet in the form "periodx" and then click on the button to fetch the values from the sheet "periody" where y = x-1.
Just replace your button handler Copy_ultimo_stock() with this one:
Sub Copy_ultimo_stock()
Dim wsCur As Worksheet, wsPrev As Worksheet
Set wsCur = ActiveSheet
' We will suppose that all Worksheets are named like "periodx"
' where x is an integer identifying the period
On Error Resume Next ' try fetching the previous ws as "periody" where y = x-1
Dim x As Integer: x = CInt(Mid(wsCur.Name, Len("period") + 1))
Set wsPrev = ThisWorkbook.Sheets("period" & (x - 1))
If Err.Number <> 0 Then
msgBox "Could not find the previous worksheet, Please check Worksheet names"
Exit Sub
End If
On Error GoTo 0
' Now we copy the previous values. You can customize the ranges if the design changes
wsCur.Range("D2:L8").Value = wsPrev.Range("D10:L16").Value
End Sub
Moreover, you can automate the generation of a new period worksheet by adding another button, say "Generate Next Period", that will create the new ws and give it the appropriate name. This will save the user the task of copying the sheet and renaming it. The code for the new button will be like this:
Sub create_next_period()
Dim wsCur As Worksheet, wsNext As Worksheet
Set wsCur = ActiveSheet
On Error Resume Next
Dim x As Integer: x = CInt(Mid(wsCur.Name, Len("period") + 1))
If Err.Number <> 0 Then
msgBox "Please check Worksheet name. It should be named periodx"
Exit Sub
End If
Set wsNext = ThisWorkbook.Sheets("period" & (x + 1))
If Err.Number = 0 Then
msgBox "The worksheet " & wsNext.Name & " already exists"
Exit Sub
Else
Err.Clear
wsCur.Copy After:=Worksheets(Worksheets.Count)
Set wsNext = Worksheets(Worksheets.Count)
wsNext.Name = "period" & (x + 1)
wsNext.Activate
Call Copy_ultimo_stock
End If
End Sub
When you name your cells do:
Range("whatever").name="Sheet!Name"
and not just
Range("whatever").name="Name"
==> this way you can gave the same named range on several sheets without any problem
Hope this helps.
However I wouldn't advice using too much named ranges...

Copy the last non empty cell

I have been working on a code that I need to always copy the lat NON empty cell of column C in the spreadsheet called "Support2". Then I need to paste in the spreadsheet "Final", always on the cell A2. So I will update the spreadsheet everyday and more values will be added on Column C, that's why it needs to copy always the last one. I have tried the code below but it is not working. I would appreciate your help, Thanks!
Sub test()
Dim myLastCell As Range
Set myLastCell = LastCell(Worksheets("Support2").Range("C:C"))
End Sub
' Now Copy the range:
Worksheets("Support2").Range("C:c" & myLastCell.Row).Copy
Else
MsgBox ("There is no data in specified range")
End If
End Sub
Needed another Sheet("Support2) in it
Sub test()
Sheets("Support2").Range("C" & Sheets("Support2").Range("C1").End(xlDown).Row).Copy
Sheets("Final").Range("A2").PasteSpecial (xlPasteValues)
End Sub

Fill in blanks in excel with vba

Im working with a large dataset in excel whose boundaries may change with updates.
I need an automated method to fill in all blank cells with a place holder such as 'n/a'.
Is there a quick way to do that?
Thanks
You will need to loop through cells in your range and wherever you encounter a blank, you'll need the following code
' e.g. you need to make cell A2 read #N/A, i.e. the error value
ActiveSheet.Range("A2").Value = CVErr(xlErrNA)
If you simply need to put the string "N/A" and not the equivalent of the error function =NA() do have a look at the code provided by Gary's Student.
How about:
Sub NoBlanka()
For Each r In Selection
If r.Text = "" Then
r.Value = "n/a"
End If
Next r
End Sub
Select your group of cells and run the macro.
Not 100% clear on requirements, but maybe give this a try. Should be entered into your worksheet code module, and the worksheet name where commented should be changed to whatever name you are using for your sheet.
Private Sub Worksheet_Change(ByVal Target As Range)
Static r As Range
With Worksheets("mySheet")
If .UsedRange Is Nothing Then Exit Sub
If r Is Nothing Then
Set r = .UsedRange
On Error Resume Next
r.SpecialCells(xlBlanks).Value = CVErr(xlErrNA)
On Error GoTo 0
Exit Sub
End If
On Error GoTo ERREUR
If r.Address <> .UsedRange.Address Then
On Error goto 0
Set r = .UsedRange
On Error Resume Next
r.SpecialCells(xlBlanks).Value = CVErr(xlErrNA)
On Error GoTo 0
End If
End With
ERREUR:
Set r = Nothing
End Sub
Not sure if this is what you need. I used a Macro-recorder in Excel.
Sub Macro1()
Cells.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "na"
End Sub
You don't even need vba to do this. You can use the special cells.
In the Home tab of the ribbon, click Find and Select (in the Editing section at the right of the ribbon) and choose Go To Special
Select Blank Cells. Then ok. This will select all your blank cells.
Now type = and your place holder. So for n/a you would simply type ='n/a

VBA return sum of range values from different workbook

I am trying to use VBA in an excel sheet (lets call it wbA) to find the sum of the values in a range of cells in another workbook (lets call that wbB). I have tried using a custom made summing function
Function sumrange(rng As Range)
summ = 0
For Each cell In rng
summ = summ + cell.Value
Next
sumrange = summ
End Function
which i execute in the wbA here
Sub test4()
Dim app As New Excel.Application
Dim book As Excel.Workbook
Set book = app.Workbooks.Add("...\wbB.xlsm")
With book.Worksheets("November2013")
a = sumrange(Range("B5:T9"))
End With
MsgBox a
End Sub
This returns the sum of the set range in wbA instead of wbB
i have also tried the worksheetfunction.sum option in the following formats
l = book.Worksheets("November2013").Application.WorksheetFunction.Sum(Range(B5:T9"))
and
With book.Worksheets("December2014")
p = Application.WorksheetFunction.Sum(Range(B5:T9"))
End With
but both caluclate and return the sum of the range from wbA instead of from wbB
How do i write the code to find sum of range in wbB
Thanks
For those who are still looking for a one-line-solution:
Cells(10, 1) = WorksheetFunction.Sum(Worksheets("data").Range(Worksheets("data").Cells(3, 35), Worksheets("data").Cells(131, 35)))
Just took it from my code, it addresses the range by cells, but you can easily use RANGE("...") instead of the CELLS(,) function).
The example line above writes the sum of worksheet "data" (range("AI3:AI131")) to A10 of current worksheet.
Your code works for me with the change that I mentioned. This is what I tried
When you specify a range without fully qualifying it, it will always refer to active sheet. And ActiveSheet might not be the sheet that you expect it to be and hence fully qualify your objects.
Sub test4()
Dim book As Workbook
Dim a
Set book = Workbooks.Open("C:\Book1.xlsx")
a = sumrange(book.Worksheets(1).Range("A1:A4"))
MsgBox a
End Sub
Function sumrange(rng As Range)
summ = 0
For Each cell In rng
summ = summ + cell.Value
Next
sumrange = summ
End Function
I notice that you are using
Set book = app.Workbooks.Add("...\wbB.xlsm")
Use .Open Like I have done.
EDIT:
#SiddharthRout yes i am running it from the VBA window in excel – user3041384 3 mins ago
In such a case, you don't need to define your excel application. Your code can be re-written as
Sub test4()
Dim book As Workbook, a
Set book = Workbooks.Open("...\wbB.xlsm")
With book.Worksheets("November2013")
a = sumrange(.Range("B5:T9"))
End With
MsgBox a
End Sub