I have created a for loop to detect where does an empty value appears in range "E7:AB7". Once done that I want to create a Range from E7 to that empty value so it can copy and paste the data from a Master Sheet only within that range.
For example if it detects an empty value in X7 then the Range must be ("E7:X7").
Here is a sample of the code:
Sub Macro5()
For Each cell In Worksheets("Proof").Range("E7:AB7")
If IsEmpty(cell) Then
Dim Cval As Range
Set Cval = Worksheets("Proof").Range(cell.Address)
Exit For
End If
Next
Sheets("MasterSheet").Range("A3:AG5000").AdvancedFilter Action:= _
xlFilterCopy, CopyToRange:=Range("E7" & ":" & Cval), Unique:=False 'Here is where the dynamic range exists
End Sub
Someone have an idea on how to apply it to the Range function?
Thanks!
Please play a little with the code below.
Private Sub Test()
Dim Rng As Range ' dynamic range in row 7
With Worksheets("Proof")
Set Rng = .Range(.Cells(7, "E"), .Cells(7, "E").End(xlToRight))
' use the line below to include the blank in the range
' Set Rng = .Range(.Cells(7, "E"), .Cells(7, "E").End(xlToRight).Offset(0, 1))
End With
' Debug.Print Rng.Address
Sheets("MasterSheet").Range("A3:AG5000").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Rng, _
Unique:=False 'Here is where the dynamic range exists
End Sub
Set Rng = .Cells(7, "E").End(xlToRight) sets a range of a single cell, defined as the last used cell before a blank cell, looking from E7 to the right. A range from E7 to that cell therefore excludes the blank cell itself. Therefore, in your example, if E7 itself is blank the code will crash or maybe set a range D7:E7, neither of which you want. Therefore you may prefer to include the blank cell in the range as, in fact, your code suggested.
Your code CopyToRange:=Range("E7" & ":" & Cval) has two flaws, at least one of which proved fatal. One is that you calculate the range at the time of using it. In my code the range is prepared before use so that you can check its address before you feed it to the filter. The other flaw is that you don't specify the sheet on which your range is supposed to exist. Therefore it will be on the ActiveSheet which could be any sheet at all. My code, you may argue, doesn't specify the worksheet, either. That isn't entirely true. Try Debug.Print Rng.Worksheet.Name.
Related
I'm using excel vba to delete filtered rows. The code is working just when I specified the range to be on A1 and put my table headers on A1. But, my table headers on B9 so I need to put it on the range but that error occurs. I didn't know why its working for Range("A1") and it didn't work for Range("B9"). In addition when I put A1 as my range to my table it deleted all the rows not just the filtered rows.
Sub Delete_CD_Blanks()
Dim Rng As Range
Dim Rng_Del As Range
Set Rng = Range("B9").CurrentRegion
If Sheets("tt").AutoFilterMode = True Then
Sheets("tt").AutoFilter.ShowAllData
End If
' Rng.AutoFilter field:=4, Criteria1:=” = ”
Rng.AutoFilter field:=6, Criteria1:="??? ?????"
Rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Sheets("tt").AutoFilterMode = False
End Sub
You did not ask my clarification questions and I (only) suppose that your problem stays in the fact that there are some cells above the 9th row, which make part from the CurrentRegion. If I am right, please add a code line, able to create a range starting from 9th row (inclusive):
'your existing code
Set rng = Range("B9").CurrentRegion 'existing in your code
Set rng = Intersect(rng, ActiveSheet.rows("9:" & rng.rows.count)) 'it creates a range slice, starting from 9th row and ending to the `CurrentRegion` last row
'your existing code
I am trying to make a macro using the SUMPRODUCT function together with SUMIF.
but when I run the macro I get …
run-time error 13.
I have tryed to make the same function just in a cell looking like this.
=SUMPRODUCT(SUMIF(B2:B3,K15:K18,L15:L18))
and it works fine, so I know the concept is proven.
Sub GrandTotal() 'Finds the last non-blank cell in a single row or column
Dim lRow As Long
Dim lCol As Long
Dim GrandTotal As Variant
Dim MyRg1 As Variant
Dim MyRg2 As Variant
Dim MyRg3 As Variant
'Find the last non-blank cell in column A(1)
lRow = Cells(Rows.Count, 1).End(xlUp).Row
'Find the last non-blank cell in row 1
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
MsgBox "Last Row: " & lRow & vbNewLine & _
"Last Column: " & lCol
'set range
Set MyRg1 = Range("B2:B3")
'set criteria
Set MyRg2 = Range("$K$15:$K$18")
'set sum range
Set MyRg3 = Range("$L$15:$L$18")
For Each cell In Range(Cells(lRow, 2), Cells(lRow, lCol))
GrandTotal = WorksheetFunction.SumProduct(WorksheetFunction.SumIf(MyRg1, MyRg2, MyRg3))
cell.Value = GrandTotal
Next cell
End Sub
I have found some guides how to use the function in VBA and I followed the same princip, also i saw an other post here on stack that showed how to do, and yet I get the error.
hope some kind soul can help
First, each variable that is being assigned a Range object can be declared as a Range, instead of Variant. Also, the ranges that are being passed to SUMIF don't seem correct. The first argument or criteria range should be the same size as the third argument or sum range. So I am going to assume that the ranges assigned to MyRg1 and MyRg2 should be the other way around. So to start with we should have the following...
Dim MyRg1 As Range
Dim MyRg2 As Range
Dim MyRg3 As Range
'set criteria range
Set MyRg1 = Range("$K$15:$K$18")
'set criteria
Set MyRg2 = Range("B2:B3")
'set sum range
Set MyRg3 = Range("$L$15:$L$18")
Secondly, you won't be able to use WorksheetFunction.Sumproduct that way. You can, however, use the Evaluate method..
GrandTotal = Evaluate("SUMPRODUCT(SUMIF(" & MyRg1.Address & "," & MyRg2.Address & "," & MyRg3.Address & "))")
Note, though, the Evaluate method has a limitation. It does not accept more than 255 characters. In any case, since you want to transfer the result to a cell, you can first enter the actual formula in the cell, and then convert it into a value...
With cell
'enter the formula in the current cell
.Formula = "=SUMPRODUCT(SUMIF(" & MyRg1.Address & "," & MyRg2.Address & "," & MyRg3.Address & "))"
'convert the formula into a value
.Value = .Value
End With
Hope this helps!
After you have your function working, you can turn on the Macro Recorder, click the cell with the function you need, hit F2, and hit Enter. You will have VBA that does what you want.
Error 13 is a Type mismatch error. I looked up the documentation of WorksheetFunction.SumIf. It says the first argument should be of type Range, and the second and third a Variant. I can not test now, but try to declare MyRg1 as a Range.
This would be a good use for ConvertFormula since you have successfully built the formula in Excel, you just need VBA to generate the value. Note that convertformula cannot handle formulas over 255 characters.
Here's roughly how you could apply it. It's
Sub heresExample()
'formula with the cell in exitance
Dim fCell As Range
Set fCell = Range("G10") 'set this up with a formula that works for
'if you were to copy paste formula.
'Your original code modified
Dim cell As Range
For Each cell In Range(Cells(lRow, 2), Cells(lRow, lCol)).Cells
'Takes the formula and applies the value if from that exact cell.
'(you don't really need grand total)
GrandTotal = Evaluate(Application.ConvertFormula(fCell.Formula2R1C1, xlR1C1, xlA1, , cell))
cell.Value = GrandTotal
Next cell
End Sub
I have done some VBA in the past but just cannot find a solution for this one.
I am looking for a macro which searches cells C4 to Z4 (one infinite long row starting from C4) for a value (number) from cell B4 which changes weekly. If a match is found then copy&pastes the values of cells B5 to B100 (one infinite long column starting from B5) into the correct column C to Z (from C5 etc., downwards).
With correct column I mean the column where the macro finds the match between B4 and C4 to Z4. C4 to Z4 are non-identical.
I searched long and hard and the nearest I could find is this:
Macro that looks for a value in a cell & then paste a range in the column of that cell. EXCEL 2007
However it does not work for me. The solution in that thread says that the matching cell values should be in a date format. I recontructed all of this, but even with dates instead of numbers it does not work. The macro always gives the message according to the VBA line
MsgBox "Date Column for " & CStr([B2].Value) & " Not Found"
So it does not find any matches for me, even I run it with identical dates in the matching cells. (I changed of course this macro to my cell locations)
This forum is my final try :)
I have following code which does not work:
Private Sub CommandButton2_Click()
Dim ws As Worksheet
Dim rSrc As Range
Dim rDst As Range
Dim cl As Range
Dim dat As Variant
Set ws = ActiveSheet
' Get the Source range
Set rSrc = ws.Range([B5], ws.Columns(2).Cells(ws.Rows.Count, 1).End(xlUp))
dat = rSrc
' Find the Destination column and copy data
Set rDst = ws.Range([D4], ws.Rows(1).Cells(1, ws.Columns.Count).End(xlToLeft))
Set cl = rDst.Find(What:=[B4], _
After:=rDst.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If cl Is Nothing Then
MsgBox "Column for " & CStr([B4].Value) & " Not Found"
Else
Set rDst = cl.Offset(1, 0).Resize(UBound(dat, 1), 1)
rDst = dat
End If
End Sub
Thank you.
Regards
Sub FindandCopy
Dim what as range
dim where as range
dim found as range
set what = range("b4") 'what we're looking for
set where = range("c4") 'start of search range
do
if where = what then
set found = where 'that's where we found it
else
set where = where.offset(0,1) 'otherwise keep looking
end if
loop until where = "" 'stop if blank
if found = "" then 'we fell off the end
msgbox what & " not found "
else
range(range("b5"),range("b5").end(xldown)).copy
found.offset(1,0).pastespecial xlpastevalues
end if
end sub
I can pull together a decent macro that does what I need but I forgot that the range will change everyday.
To be specific the row count will get higher.
Right now my macro goes through and hides any row that doesn't have today's date and then copies a set range to a worksheet in a different workbook.
The only problem I have is that range will change everyday, so I figure I need a way to copy only rows with data in them once the rest are hidden and then paste them to the other workbook.
Sub automate()
Dim cell As Range
For Each cell In Range("AB2:AB30000")
If cell.Value < Date And cell.Value <> Empty Then cell.EntireRow.Hidden = True
Next
Range("K28336:K28388,O28336:O28388,P28336:P28388,Q28336:Q28388,R28336:R28388,S28336:S28388,T28336:T28388,U28336:U28388,V28336:V28388,Y28336:Y28388,AA28336:AA28388,AB28336:AB28388").Select
Selection.Copy
Workbooks.Open ("\\gvwac09\Public\Parts\Test\2014 IPU.xlsx")
Sheets("Historical Data").Activate
ActiveSheet.Range("c1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteFormats
ActiveSheet.Paste
This is my macro so far. I'm sorry if I didn't format this post correctly, new to this.
I do not understand exacting what you are attempting but I believe I can give you some useful pointers.
I do not explain the statements I use in the code below. Look them up in the Visual Basic Editor's Help or try searching the web for "Excel VBA xxxxx". Come back with questions if necessary but the more you can discover for yourself, the quicker your skills will develop.
Firstly you need to find the last row containing data. Examining every row down to AB30000 just wastes time. Macro Demo1 below demonstrates two techniques. There are more techniques for finding the last row, none of which are appropriate in every situation. Search StackOverflow for "[excel-vba] find last row". There are lots of relevant questions and answers although the first technique I use is far and away the most popular.
General advice: If you can break your requirement down to a sequence of single issues (such as "find last row"), you will find it easier to search StackOverflow for an answer.
Always include Application.ScreenUpdating = False at the start of your macros if you are going to amend a worksheet. Without this statement, everytime you hide a row, Excel repaints the screen.
I have created some test data which I hope is representative of your data. I have two worksheets Source and Dest. Source contains the full set of data. I copy the selected rows to Dest.
I have used Auto Filter which will be much faster than your technique if it will give you the effect you seek. Play with Auto Filter from the keyboard. If you can get the effect you seek, turn on the Macro Recorder, use Auto Filter to get the selection you seek and switch the Macro Recorder off. Adjust the Macro Recorder's statements to remove Selection and replace the corresponding statements in Demo2.
The secret of Demo2 is Set Rng = .AutoFilter.Range.SpecialCells(xlCellTypeVisible) which sets Rng to the visible rows. If you cannot get Auto Filter to work as you wish and you decide to use your current technique to set uninteresting rows invisible, keep this statement to get the remaining rows. However, I think macro Demo3 uses a better technique.
Option Explicit
Sub demo1()
Dim ColLast As Long
Dim Rng As Range
Dim RowLast As Long
Application.ScreenUpdating = False
With Worksheets("Source")
' This searches up from the bottom of column AB for a cell with a value.
' It is the VBA equivalent of placing the cursor at the bottom of column AB
' and clicking Ctrl+Up.
RowLast = .Cells(Rows.Count, "AB").End(xlUp).Row
Debug.Print "Last row with value in column AB: " & RowLast
' This searches for the last cell with a value.
Set Rng = .Cells.Find(What:="*", After:=.Range("A1"), SearchDirection:=xlPrevious)
If Rng Is Nothing Then
' Worksheet is empty
Else
RowLast = Rng.Row
ColLast = Rng.Column
Debug.Print "Last cell with value is: (" & RowLast & ", " & ColLast & _
") = " & Replace(Rng.Address, "$", "")
End If
End With
End Sub
Sub Demo2()
Dim Rng As Range
Dim SearchDate As String
SearchDate = "14-May-14"
Application.ScreenUpdating = False
With Sheets("Source")
.Cells.AutoFilter
.Cells.AutoFilter Field:=28, Criteria1:=SearchDate
Set Rng = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
End With
' Rng.Address has a maximum length of a little under 256 characters.
' Rng holds the addresses of all the visible rows but you cannot display
' all those addresses in an easy manner. However, this is only to give
' you an idea of what is in Rng; the Copy statement below uses the full
' set of addresses.
Debug.Print "Visible rows: " & Rng.Address
Rng.Copy Worksheets("Dest").Range("A1")
End Sub
Sub Demo3()
Dim RngToBeCopied As Range
Dim RowCrnt As Long
Dim RowLast As Long
Dim SearchDate As Long
' Excel holds dates as integers and times as fractions.
SearchDate = CLng(DateValue("20 May 2014"))
With Worksheets("Source")
RowLast = .Cells(Rows.Count, "AB").End(xlUp).Row
' Include header row in range to be copied
Set RngToBeCopied = .Rows(1)
For RowCrnt = 2 To RowLast
If .Cells(RowCrnt, "AB").Value = SearchDate Then
Set RngToBeCopied = Union(RngToBeCopied, .Rows(RowCrnt))
End If
Next
End With
Debug.Print RngToBeCopied.Address
RngToBeCopied.Copy Worksheets("Dest").Range("A1")
End Sub
I'm trying to define a named range in Excel using VBA.
Basically, I have a variable column number. Then a loop runs to determine the first empty cell in that particular column.
Now I want to define a named range from row 2 of that particular column to the last cell with data in that column (first empty cell - 1).
For example, column 5 is specified, which contains 3 values. My range would then be (2,5)(4,5) if I'm correct.
I'm just wondering how to specify this range using only integers instead of (E2:E4).
Is it at all possible?
I found this code to define a named range:
'Change the range of cells (A1:B15) to be the range of cells you want to define
Set Rng1 = Sheets("Sheet1").Range("A1:B15")
ActiveWorkbook.Names.Add Name:="MyRange", RefersTo:=Rng1
Could anyone nudge me into the right direction to specify this range using integers only?
As your targeting a range of E2:E4 you would need to specify the cell locations. The below function might be of use to you, pass it the column number e.g. 5 and it will retunn the address so 5=E and 27=AA
ColLetter = ColNo2ColRef(colNo)
Set Rng1 = Sheets("Sheet1").Range(ColLetter & "2:" & ColLetter & "4")
ActiveWorkbook.Names.Add Name:="MyRange", RefersTo:=Rng1
Function ColNo2ColRef(ColNo As Long) As String
ColNo2ColRef = Split(Cells(1, ColNo).Address, "$")(1)
End Function
Hope this helps
EDIT: Or:
Set rng = Range(Cells(2, 5), Cells(4, 5)) 'E2:E4
ActiveWorkbook.Names.Add Name:="MyRange", RefersTo:=Rng
or alternatively
Sub test()
Set rng1 = Cells(2, 2) 'B2
Set rng2 = rng1.Resize(3, 1) 'B2:B4
'or
Set rng2 = Range(rng1, Cells(4, 2)) 'B2:B4
End Sub
or do it directly without looping using
With Sheet1
col = 5 'variable col
Set rng1 = .Range(.Cells(2, col), .Cells(.Rows.Count, col).End(xlUp))
End With
which is the same as
with sheet1
Set rng1 = .Range(.Range("E2"), .Range("E" & .Rows.Count).End(xlUp))
end with
EDIT: If you're setting up named ranges to change dynamically then you don't need VBA. Enter this directly into the named range in Excel and leave it to auto adjust automatically between E2 and whatever the last item is (assuming no blanks). =$E$2:INDEX($E$2:$E$5000,COUNTA($E$2:$E$5000)) (Extend 5000 if you need need more rows)