I'm trying to write a small piece of VBA that will shade a column of excel cells based on RGB variables in adjacent columns. So I have a table of data (no headings) with 3 columns (R G and B) and x rows (amount will vary). What I would like is to colour a 4th column to the right of this table in a colour based on the 3 numbers to the left. Note that I plan to select the top left cell each time I perform this.
Below is the code I have used but I get an error message:
Error 438... Object doesnt support this property or method
pointing to the Set rng line as being the problem.
Any thoughts or help much appreicated
Sub RGBTest()
Dim rng As Range
Dim n As Integer
Set rng = ActiveSheet.ActiveCell.CurrentRegion
ActiveCell.Offset(0, 3).Activate
For n = 1 To rng.Rows.Count
ActiveCell.Interior.Color = RGB(rng.Cells(n, 1), rng.Cells(n, 2), rng.Cells(n, 3))
ActiveCell.Offset(1, 0).Activate
Next n
End Sub
So the line
Set rng = ActiveSheet.ActiveCell.CurrentRegion
causes the error Error 438... Object doesnt support this property or method.
That means either ActiveSheet doesn't support .ActiveCell or ActiveCell doesn't support .CurrentRegion.
ActiveCell is a range and CurrentRegion is a property of Range so that shouldn't be it.
However, ActiveCell is not a property of a worksheet but of Application. That makes sense since there is only one active cell per Excel instance, not per sheet. So instead of
Set rng = ActiveSheet.ActiveCell.CurrentRegion
just use
Set rng = ActiveCell.CurrentRegion
Related
I'm not sure why the following code gives a "Not found" Message when the value in the initial active cell (-15.0) is also a value within the specified range.
Sub Test()
Dim c As Double
Dim srchRng As Range
With ActiveWorkbook.ActiveSheet
c = ActiveCell.Select
Set srchRng = .Range("V17:V37").Find(what:=c)
If srchRng Is Nothing Then
MsgBox "Not found"
End If
End With
End Sub
Note sometimes a value of 0 exists within the specified range. If so I don't need to do anything but if 0 does not exist, I first need to find the least negative value (I use separately within the worksheet =MAX(IF(V17:V37<=0,V17:V37),MIN(V17:V37)) and this becomes my initial active cell value [eg -15.0] to look for in the specified range), and this least negative value will then be set to zero (by using a goal seek function in this cell)
So this macro will ultimately incorporate an If statement or conditional lookup
Any feedback appreciated.
I made suggested changes but revised code below still returns "Not found".
Cell V38 has the value -15.0 but this number does appear in the range V17:V37.
This simple macro should result in the cell in the range corresponding to the c value being selected. Any further help appreciated.
Dim c As Double
Dim srchRng As Range
With ThisWorkbook.Sheets("Reel_Pack")
c = Range("V38")
Set srchRng = .Range("V17:V37").Find(what:=c)
If srchRng Is Nothing Then
MsgBox "Not found"
End If
End With
End Sub
I found the following code to do the above.
Dim c As Double
c = ThisWorkbook.Sheets("Sheet1").Range("V58").Value
Dim cel As Range
For Each cel In ThisWorkbook.Sheets("Sheet1").Range("V17:V57")
With cel
If .Value = c Then
.Select
End If
End With
Next cel
End Sub
But can someone suggest please how to improve this by actually incorporating the equation I have in cell V58 within this macro? As mentioned that equation is =MAX(IF(V17:V37<=0,V17:V37),MIN(V17:V37)).
So the macro would look into the range V17:V37 and if there is an exact zero then Do Nothing otherwise locate the cell with the least negative number (which is what the equation above does) and select that cell.
I hope this is the correct reason:
c = ActiveCell.Select is returning the value -1 which equates to TRUE in VBA.
So, I think, the line is asking the question c = ActiveCell is Selected? which returns a boolean TRUE/FALSE converted to a double which equals -1.
c = ActiveCell returns the default property of the ActiveCell which is Value.
So that line should read c = ActiveCell or c = ActiveCell.Value rather than c = ActiveCell.Select.
Edit:
Not so sure of my reasoning now - c= Range("A1").Select selects cell A1 and returns -1 still.
I guess that why you should avoid Select like the plague unless you want to actually select a cell rather than just reference it. Have a read of How to avoid using Select in Excel VBA
At the moment I’m only able to copy&paste stuff from one row.
I use the code below:
Dim lastRow As Long
With Sheets("Tab1")
If Application.WorksheetFunction.CountA(.Columns(3)) <> 0 Then
lastRow = .Cells(Rows.Count, "C").End(xlUp).Row + 1
Else
lastRow = 1
End If
Sheets("Tabelle2").Range("B85:S85").copy
.Range("C" & lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
My problem is that I need to copy and paste lists. Can someone show me how to use this code to copy&paste lists?
I wanted to copy more rows, like (A25:S25, A27:S27, A30:S30)
It should copy always the same rows.
There are two reasons for your code copying just one row:
The code selects just one row to copy
Sheets("Tabelle2").Range("B85:S85").Copy
The select just on row to Paste
.Range("C" & lastRow).PasteSpecial Paste:=xlPasteValues …
As it’s not clear if you want to copy several rows despite selecting just one or to copy that one row to several rows I’ll cover both options in order to give you an idea of what to do in both cases:
Setting the range to be copied
a. To copy just range B85:S85 one row only then what you are doing is correct
Wbk.Sheets("Tabelle2").Range("B85:S85")
b. To copy X rows down from row 85 (including row 85)
Wbk.Sheets("Tabelle2").Range("B85:S85").Resize(X)
c. To copy Y rows up from row 85 (including row 85)
Wbk.Sheets("Tabelle2").Range("B85:S85").Offset(1-Y, 0).Resize(Y)
d. To copy the range bounded by any combination of blank rows and blank columns in which "B85:S85" is included (see Range.CurrentRegion Property (Excel))
Wbk.Sheets("Tabelle2").Range("B85:S85").CurrentRegion
Note that this will include also any rows above and below row 85 if they have at least one cell not blank that causes the "current region" to extend upwards or downwards and it will also include any columns to the left of columns B or to the right of column S if they have at least one cell not blank that causes the "current region" to extend sideways
This procedure demonstrates the options explained above:
Sub Range_Set()
Dim rSrc As Range
With ThisWorkbook.Sheets("Tabelle2")
'If want to copy just this row 85
Application.Goto .Cells(1), 1
Set rSrc = .Range("B85:S85")
rSrc.Select: Stop
'If want to copy 5 rows down from row 85 (including row 85)
Application.Goto .Cells(1), 1
Set rSrc = .Range("B85:S85").Resize(5)
rSrc.Select: Stop
'If want to copy 5 rows up from row 85 (including row 85)
Application.Goto .Cells(1), 1
Set rSrc = .Range("B85:S85").Offset(-4, 0).Resize(5)
rSrc.Select: Stop
'If want to copy then range bounded by any combination of blank rows and blank columns in which "B85:S85" is included
'This will include also any rows above and below row 85 if they have at least one cell not blank that causes the "current region" to extend upwards or downwards
'Also will include also any columns to the left of columns B or to the right of column S if they have at least one cell not blank that causes the "current region" to extend sideways
Application.Goto .Cells(1), 1
Set rSrc = .Range("B85:S85").CurrentRegion
rSrc.Select: Stop
End With
End Sub
Setting the range where the copy takes place
To copy the source range as it is, then just need to select the first cell of your target range and the paste.special will cover paste the target to all cells required as per the size all target cell. However is you want to copy range B85:S85’ to several cell then you need to select the target rows. For example if we want to copyB85:S85’ over five rows starting at C5 then we need to set the target range as
.Range("C12").Resize(5).PasteSpecial Paste:=xlPasteValues
As we are going to copy only the values of the source, I suggest to use the Range.Value property of the Range object instead of the Copy…Paste method. One advantage of using this property is to avoid the use of the Clipboard.
Try this code (select\adjust the options as per your requirements)
Sub Range_Value()
Dim Wbk As Workbook
Dim lastRow As Long
Dim rSrc As Range
Rem Declare Objects
Set Wbk = ThisWorkbook 'use this if procedure is resident in the wbk with the tables
'Set Wbk = Workbooks(WbkName) 'use this if procedure is not resident in the wbk with the tables - update wbk name
With Wbk.Sheets("Tab1")
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Rem Set Copy Range
'since we are going to paste only values then we can save us from using the clippboard
'Sheets("Tabelle2").Range("B85:S85").Copy
'instaed create a range to replace the values of the target range with the values of this range
'Uncomment\Update the option needed according to you requirements
'for this test I'm using option b
'a. To copy just row 85
'Set rSrc = Wbk.Sheets("Tabelle2").Range("B85:S85")
'b. To copy X rows down from row 85 (including row 85) X=5
Set rSrc = Wbk.Sheets("Tabelle2").Range("B85:S85").Resize(5)
'c. To copy 5 rows up from row 85 (including row 85) Y=5
'Set rSrc = Wbk.Sheets("Tabelle2").Range("B85:S85").Offset(-4, 0).Resize(5)
'd. To copy the range bounded by any combination of blank rows and blank columns in which "B85:S85" is included
'This will include also any rows above and below row 85 if they have at least one cell not blank that causes the "current region" to extend upwards or downwards
'Also will include also any columns to the left of columns B or to the right of column S if they have at least one cell not blank that causes the "current region" to extend sideways
'Set rSrc = Wbk.Sheets("Tabelle2").Range("B85:S85").CurrentRegion
' As mentioned before we won't use the clipboard
'instead we replace the values with the values of the target range created earlier
'however we need to extend the range to the same size of the source range
.Range("C" & lastRow + 1).Resize(rSrc.Rows.Count, rSrc.Columns.Count).Value = rSrc.Value2
End With
End Sub
Hope this is clear enough and helps you to make progress with you coding, nevertheless let me know of any questions you might have.
I'm not quite sure what you're looking for - but here' how to loop:
Sub test()
For i = 25 to 30
Range(Cells(i,1),Cells(i,19)).Copy
Range(Cells(i,20),Cells(i,39)).PasteSpecial xlPasteValues
Next i
End Sub
That copies A25:S25 and pastes to T25:AM25...Then A26:S26, pastes T26:AM26, etc. until row 31.
Well now that the requirements are disclosed, we have the opportunity to apply another method. Bear in mind that the fact that the source range contains multiple areas may give us the idea of series of repetitive "copy paste values" which makes the undesirable use of the clipboard, or a repetitive Range Values.
This time instead of setting the source range as an object (which still can be done) we'll use an Array variable to grab the values of the multi-areas range
to later enter them in the target range as a unified and continuous range in one step.
This procedure sets an array with the values of the source range areas and then sets the values of the array to the target range using the Range.Value property.
Sub Range_MultiAreas_CopyValue()
Const kRowIni As Long = 25
Dim Wbk As Workbook
Dim aRngSrc() As Variant
Dim lRowLst As Long, l As Long, b As Byte
Rem Declare Objects
Set Wbk = ThisWorkbook
Rem Set Array with rows to copy as value
With Wbk.Sheets("Tabelle2")
l = kRowIni
For b = 1 To 30
If .Range("V" & l).Value2 = 0 Then
Rem Resize Array
On Error Resume Next
ReDim Preserve aRngSrc(1 + UBound(aRngSrc))
If Err.Number <> 0 Then ReDim Preserve aRngSrc(1)
On Error GoTo 0
Rem Set Row Values In Array
aRngSrc(UBound(aRngSrc)) = .Cells(l, 2).Resize(, 16).Value2
Rem Increase Row Pointer
l = l + 2
End If: Next: End With
Rem Reset Arrays Structure
With WorksheetFunction
aRngSrc = .Transpose(.Transpose(aRngSrc))
End With
Rem Let Array Values in Target Range
With Wbk.Sheets("Tab1")
lRowLst = .Cells(.Rows.Count, 1).End(xlUp).Row
lRowLst = IIf(.Cells(1, 1) = Empty, 1, lRowLst + 1)
.Cells(lRowLst, 1).Resize(UBound(aRngSrc, 1), UBound(aRngSrc, 2)).Value = aRngSrc
End With
End Sub
Once again let me know of any question you might have about the resources used.
As it is not possible to Copy more than one row at once when gaps are between as siddharth rout said we tried to bypass the problem with looping through every signle row which should be copiedand added an if query.
This code is working and i am using "him" now
j = 0
For i = 1 To 30
With Sheets("Arbeiter-Tage")
If Application.WorksheetFunction.CountA(.Columns(1)) <> 0 Then
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
Else
lastRow = 1
End If
Sheets("Vorlage").Activate
If ActiveSheet.Range("V" & 25 + j).Value = 0 Then
ActiveSheet.Range("B" & 25 + j & ":" & "Q" & 25 + j).Copy
.Range("A" & lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End With
j = j + 2
I have a list of query words that I am submitting to a database (Column A) to generate a list of coded matches (Columns F-H). Column F is the original search word (so there is an exact match somewhere in Column A), Column G contains the match, and Column H contains the code for the match. What I need to do is take the query word in Column F and find its partner in Column A. Then I need to take the corresponding match and its code and paste it next to the original search term in Column A (in Columns B&C).
My problem here is getting the information pasted in the correct cell since the copy to and paste from locations change every time -- The list of coded matches in Columns F-H does NOT contain all of the terms in Column A.
I've been searching the internet and I can't seem to figure out what exactly I need to change to allow the paste function to work.
I have attached an image of a simplified version of my spreadsheet and a annotated version of the code I have been working with.
Sub FindMatch()
LastRow = Cells(Rows.Count, 6).End(xlUp).Row
For i = 1 To LastRow
FindMe = Cells(i, 6).Value
Set FoundinList = Cells.Find(What:=FindMe, After:=ActiveCell, LookAt:=xlWhole)
If Not FoundinList Is Nothing Then
FoundinList.Select
ActiveCell.Offset(0, 1).Select
'At this point the cell I want the information pasted into is selected. Yay!
'Example: I am trying to find "abnormal digits" (F1) in Column A and paste
'G1:H1 into the appropriate cells in Columns B & C (In this case B15:C15)
'At this point in the code my cursor is on cell B15 - which is where I need it.
Range(Cells(i, 7), Cells(i, 8)).Copy
'This selects the appropriate range (G1:H1 in my example).
ActiveCell.Paste
'This is the problem string. I've tried naming the "ActiveCell" before initiating the copy
'string (ActiveCell.Name = "PasteHere") and then pasting into the named cell
'(Cells("PasteHere").Paste), but that gives me an invalid procedure call or argument on:
'Cells("PasteHere").Paste I've also tried pasting into a range:Range(Cells(PasteHere, 2)
', Cells(PasteHere, 3)).Paste -AND- using the formula that is created when you a record a
'macro (Application.CutCopyMode = False) but both of those give me an application
'/object-defined error.
End If
Next i
End sub
Thank you so much in advance for reading this post and helping me out.
My Spreadsheet
End Product
This vba uses the worksheet function vlookup.
Sub ahhn()
Dim ws As Worksheet
Dim cel As Range
Set ws = ActiveSheet
With ws
For Each cel In .Range(.Range("A1"), .Range("A1").End(xlDown))
cel.Offset(0, 1) = WorksheetFunction.IfError(Application.VLookup(cel, .Range("F:H"), 2, 0), "")
cel.Offset(0, 2) = WorksheetFunction.IfError(Application.VLookup(cel, .Range("F:H"), 3, 0), "")
Next
End With
End Sub
I have a workbook with "Results" being sheet 3, this being the worksheet I want to use.
I have tried a few formulaes to try and add a macro to do the following:
I have column G with percentages. I then have column I where I would like there to be a result saying TRUE/FALSE where the contents of G are equal to 100%. Column G is formatted to percentage with two decimals.
Some considerations: I have my first row being a Hyperlink to another sheet, then my headings, then the first row of "results". I have 457 rows, if there is a measurement of the range, perhaps it could be on A?
I keep getting this error 9 with my range and have got a bit stuck.
Thanks in advance!
Sub PartialHits1()
Dim rng As Range
Dim lastRow As Long
Dim cell As Range
With Sheet3
lastRow = .Range("G" & .Rows.Count).End(xlUp).Row
Set rng = .Range("G1:G" & lastRow)
For Each cell In rng
If cell.Value = 100
Then
cell.Range("I1:I1").Value = 100
End If
Next
End With
End Sub
(I have hacked this a bit, just was trying to get it to set as 100 instead of the TRUE/FALSE Also was playing around near the Sheet 3 part as I got errors.)
RangeVariable.Range can refer only to a cell within RangeVariable, so you can't refer to column I in this way. Try: .Range("I"&cell.row)=100.
Also your criteria is probably wrong, if you have 100% in a cell it's actual value is 1.
And last question: why do you want to do this with VBA, it would be much more simple with worksheet function =IF(G3=1,100,"")
I am not sure if what I want to achieve is possible. So here it is:
I got workbook with 2 sheets:
First sheet cointains raw data with employees and trainings they did or did not take (they could not come to the the training). Sheets cointains few columns like: name, special ID (different for every employee), 2 blank columns, presence (yes/no), and few more...
Second sheet will create report based on range and presence criteria.
Technically it's something like that:
Report sheet has list of employees, they will be filtered using autofilter. Those filtered employees will be checked if they were on 14 categories of trainings. Categories differs with range (ranges are known; with time ranges will be added or adjusted to newly added trainings).
My problem:
Is it possible to create vba code that will check if employee was on certain trainings (countif in certain range with condition: not present = do not count) and paste the value to certain cells? If it is could you give some advice on how to do that? I am not asking for ready code.
Trying to make it work but I stuck at this. Error at line "if cells.find...".
Sub Check()
MyRange = Range("A1", Selection.End(xlDown))
For Each MyCell In MyRange
With Range("pp2dni2007")
If Cells.Find(MyCell.Value) Is Nothing Then
Else
If ActiveCell.Value = ActiveCell.Offset(0, 3).Value Then
MyCell.Offset(0, 6).Value = 1
Else
MyCell.Offset(0, 6).Value = 0
End If
End If
End With
Next
End Sub
2nd edit, earlier code did infinite loop. Now I think if-statements reference to wrong range but not sure how to deal with it.
Sub Check()
Dim MyRange As Range, MyCell As Variant
Range("A1").Select
Set MyRange = Range(Selection, Selection.End(xlDown)).Rows.SpecialCells(xlCellTypeVisible)
For Each MyCell In MyRange.Cells
With Range("pp2dni2007")
If .Cells.Find(MyCell.Value) Is Nothing Then
Else
If .Cells.Find(MyCell.Value).Value = .Cells.Find(MyCell.Value).Offset(0, 3).Value Then
MyCell.Offset(0, 6).Value = 1
Else
MyCell.Offset(0, 6).Value = 0
End If
End If
End With
Next
End Sub
Sample workbook: https://dl.dropboxusercontent.com/u/7421442/sample%20workbook%20(1).xls
Declare all your variables, e.g.,
Dim MyRange as Range, MyCell as Range.
Without declaration, MyCell is variant data type, and that is why you're getting an Object Required error. Then do:
For Each MyCell In MyRange.Cells
Inside the With block, you may want to use (note the . in front of Cells):
If .Cells.Find(MyCell.Value) Is Nothing Then
Further, you will probably need to revise what you're doing with ActiveCell, since this is never changing which cell is active, I'm not sure it would give you the expected results. It is always preferable to avoid relying on Active and Select methods (except for to use them as user-input). INstead, work with the range objects directly.