So I've been having an issue with this script and was wondering if anyone could point me in the right direction to fix it.
I'm trying to scan a cell range and find the value of "X", which also has to align with the array (which seems to be working) that finds a value in another range of columns that is greater than 7.
Option Explicit
Private Sub Worksheet_Activate()
Dim ws As Worksheet
Dim lRow As Long
Dim rng As Range
Dim Checks As Variant
Dim RiskName As Variant
Dim Level As Integer
Dim ThreatAgent As Variant
Dim Vulns As Variant
Dim X As Integer
Dim Y As Integer
Dim impactRange As Range
Dim impactCell As Range
Dim checksRange As Range
Dim checksCell As Range
Me.UsedRange.Offset(17).ClearContents
X = 2
Y = 1
With Sheets("TA & Vul Combinations")
.AutoFilterMode = False
Set impactRange = .Range("R3:R50")
For Each impactCell In impactRange.Cells
If impactCell.Cells > 7 And Not IsEmpty(impactCell.Cells) Then
impactCell.Copy
Sheets("temp").Range("B" & X).PasteSpecial xlPasteValues
X = X + 1
Else
End If
Next impactCell
Set checksRange = .Range("E3:E50")
For Each checksCell In checksRange.Cells
If checksCell.Cells("E3") = "X" Then
checksCell.Copy
Sheets("temp").Range("C2:AO2").PasteSpecial xlPasteValues
Else
Range("K1") = "You Broke It"
End If
Next checksCell
.AutoFilterMode = False
End With
End Sub
If anyone could give me some tips that would be great
This line is wrong:
If checksCell.Cells("E3") = "X" Then
since you are using Cells property incorrectly.
Cells property only accepts numeric arguments.
Syntax: Cells(rowindex,colindex)
Examples:
Cells(1,1) 'refers to Range("A1")
Cells(1) 'refers to Range("A1")
However, you can also use letters for Columns like this:
Cells(1,"A") 'refers to Range("A1")
Btw, this will work though.
If checksCell.Range("E3") = "X" Then
But take note of the implications.
When you use Range.Range syntax, what happens is that you use a Relative Reference on your first range.
Example1:
Range("B2").Range("E3").Address
will give you $F$4 because that is the 5th (E) column and 3rd (3) row from B2.
Other Examples:
Range("C1:E10").Range("B2").Address 'refers to $D$2
Range("C1:E10").Range("A1:B3").Address 'refers to $C$1:$D$3
Hope this clear things up a bit.
I don't know exactly what you want to achieve in your code, so I will not provide corrections.
I can only tell why you are getting errors.
If you need additional help, revise your question and clear major things up.
Re this line, which is probably the one where your error lies (it's the only if equals line in the code block):
If checksCell.Cells("E3") = "X" Then
I'm pretty certain checksCell is already a cell from doing a for each on the range checksRange, so I'm not sure that applying .Cells("E3") to it is the right thing to do, or even a sane thing to do :-)
I would think the correct way would be:
If checksCell.Value = "X" Then
Related
VBA Hey guys, I just started to work with VBA and i am looking for a solution to my problem. The task is to count the number of different Values (Suppliers) inside a column, starting at a fixed point, lets say for column A to start at A5, but end at the last value in that column. Every time i try to put the range from A5 to last written cell in column A I either get errors or a wrong answer. Anyone here that can help me out?
Sub Count_Values_()
Sheets("Präsentation").Select
Dim dblAnz As Double
Dim rngRange As Range, rngRangeCnt As Range
Set rngRange = Range("A5:A50")
For Each rngRangeCnt In rngRange
dblAnz = dblAnz + 1 / WorksheetFunction.CountIf(rngRange, rngRangeCnt.Text)
Next
Dim Bereich As Range
Dim Zelle As Range
Dim lAnzahl As Long
Set Bereich = Range("A5:A50")
For Each Zelle In Bereich
If Zelle.Font.Bold = True Then
lAnzahl = lAnzahl + 1
End If
Next Zelle
Sheets("Anleitung").Select
Range("F1").Value = dblAnz - lAnzahl - 1
End Sub
This is the code I used before by searching values from A5 to A50 and subtracting all the bold headlines. I also added a -1 as an empty cell counts as a value as well I guess or at least I got the right numbers this way.
Please, try the next way:
Sub testCountDefinedRange()
Dim sh As Worksheet, startRow As Long
Const searchVal As Double = 25.13 'what is it to be searched for
Set sh = ActiveSheet 'use here the sheet you need
startRow = 5 'the starting row of the range to be searched
Debug.Print WorksheetFunction.CountIf(sh.Range("A" & startRow, sh.Range("A" & sh.rows.count).End(xlUp)), searchVal)
End Sub
But according to community spirit, you should prove your involvement in solving the problem by your own. Even if you cannot show us a working piece of code/formula etc. Anything proving that you did something, at least, some research on the internet...
As a learning exercise & possible use in future code I have created my first Excel VBA function to return the activecell row number in any Excel Table (as opposed to the sheet itself) . Essentially it simply finds the active row in the sheet, then finds the row number of the table header which is then subtracted from the cell row number to return the row number of the table which can then be used in subsequent code. However, while it works, it dosen't look the most efficient Can anyone improve it?
Sub TableRow()
Dim LORow As Integer
Dim TbleCell As Range
Set TbleCell = Activecell
Call FuncTableRow(TbleCell, LORow)
MsgBox LORow
End Sub
Public Function FuncTableRow(ByRef TbleCell As Range, LORow As Integer) As Range
Dim LOName As String
Dim LOHeaderRow, Row As Integer
LOName = Activecell.ListObject.Name
Row = Activecell.Row
LOHeaderRow = ActiveSheet.ListObjects(LOName).HeaderRowRange.Row
LORow = Row - LOHeaderRow
Debug.Print (LORow)
End Function
This question will probably get closed for not being specific enough but the most obvious item (to me) is your usage of a custom function. Your function is not actually returning anything, it's only running a debug print. To have your function actually return the row number, you would set it as a type Long (not integer) and include the function name = to the number.
I didn't actually test your function but assuming LORow is dubug printing the proper answer then it should work like this:
Public Function FuncTableRow(ByRef TbleCell As Range, LORow As Integer) As Long
Dim LOName As String
Dim LOHeaderRow, Row As Integer
LOName = Activecell.ListObject.Name
Row = Activecell.Row
LOHeaderRow = ActiveSheet.ListObjects(LOName).HeaderRowRange.Row
LORow = Row - LOHeaderRow
Debug.Print (LORow)
FuncTableRow = LORow
End Function
You also don't Call a function, you can just insert it as itself in a subroutine.
You are using LORow as an input variable but then changing it. That's typically a bad practice.
You should not be using ActiveSheet grab the worksheet from TbleCell.Worksheet
You would almost never use activecell as part of a Custom Formula.
Dim LOHeaderRow, Row As Integer should actually be Dim LOHeaderRow as Long, Row As Long. As you currently have it LOHeaderRow is undefined/Variant.
There's probably more. I would restart your process with a simpler task of returning the last used cell in a worksheet. There's a dozen ways to do this and lots of help examples.
Take a look at this TheSpreadsheetGuru.
Here are some variables that might help you.
Sub TableVariables()
Dim ol As ListObject: Set ol = ActiveSheet.ListObjects(1)
Dim olRng As Range: Set olRng = ol.Range ' table absolute address
Dim olRngStr As String: olRngStr = ol.Range.Address(False, False) ' table address without absolute reference '$'
Dim olRow As Integer: olRow = ol.Range.Row ' first row position
Dim olCol As Integer: olCol = ol.Range.Column ' first column position
Dim olRows As Long: olRows = ol.Range.Rows.Count ' table rows including header
Dim olCols As Long: olCols = ol.ListColumns.Count ' table columns
Dim olListRows As Long: olListRows = ol.ListRows.Count ' table rows without header
End Sub
I'm new to vba and I'm struggling with this little problem.
I haven't found any posts dealing with this issue though.
here is the point:
I'd like to fill every cell of a board bellow a range of datas with a specific value.
Let's say I've already got a range of datas in the column A , I'd like, in the same column, the line after the last cell filled with "a" values ( that can vary) fill the next empty cells with a specific value ( "b").
Here is an example of what I'd like to do as a final result;
column A
a
a
a
a
a
a
b
b
b
b
b
I tried to code it but as soon as I launched it nothing happens, nothing changes.
Here it is ;
Sub test()
Dim firstlineb As Long
Dim lastlineEmpty As Long
Dim x As Integer
firstlineb = Worksheets("Sheets1").Range("A2",Range("A2").End(xlDown)).End(xlDown).Offset(1)
lastlineEmpty = Worksheets("Sheets1").Range("A2",Range("A2").End(xlDown)).End(xlDown).Offset(1).End(xlDown)
For x = firstlineb To lastlineEmpty
Cells(x, 1).Value = "b"
Next x
End Sub
I'd heavily appreciate your help. Thank you a lot !
I don't know if I understood your problem correctly but try this :
Sub test()
Dim firstlineb As Range
Dim lastlineEmpty As Range
Dim cel As Range
Set firstlineb = Range("A2").End(xlDown).Offset(1)
Set lastlineEmpty = Range(firstlineb, firstlineb.End(xlDown))
For Each cel In lastlineEmpty.Cells
If cel = "" Then
cel.Value = "b"
Else: Exit Sub
End If
Next cel
End Sub
I think you got lost with the ".End(xlDown)", if you set up the variable as a range you can then use it like a cell :
Range(firstlineb, firstlineb.End(xlDown))
This way you won't have those repetition :
Range("A2",Range("A2").End(xlDown)).End(xlDown).Offset(1).End(xlDown)
Note : I tried the vba on the sheet directly and not in a module, so you'll have to add "Worsheets("Sheet1")" before the range.
I hope that it helped you a bit.
We'll make a couple assumptions:
Columns(1) has the values you want to assess, a
Columns(2) has labels so you can find your last row for end of all data entry, so you know where Columns(1) data needs to extend, b
We want to find the last row of each (untested with explanatory comments):
With Sheets(1)
dim lastValueRow as Long
lastValueRow = .Cells(.Rows.Count, 1).End(xlUp).row 'Columns(1) = Columns("A")
dim lastDescriptionRow as Long
lastDescriptionRow = .Cells(.Rows.Count, 2).End(xlUp).row 'Columns(2) = Columns("B")
'Using the above, you can paste a single value over a range, without needing to loop
.Range(.Cells(lastValueRow+1, 1),.Cells(lastDescriptionRow, 1)).Value = "b"
End With
I have been trying to find something that can help me online but no luck. I am trying to compare a value in column A with a value in Cell E1 and if match I want to put an X in column B next to the match in Column A.
here is my code I go so far:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a As Integer
Dim i As Integer
Dim x As Range
Dim y As Range
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
i = Worksheets("Sheet1").Range("E1")
x = Worksheets("Sheet1").Range("B1:a")
y = Worksheets("Sheet1").Range("A1:a")
'For Each cell In y
'if y = i then
'print "X" in column B next to the value
'MsgBox (i)
End Sub
thanks for your help in advance
Dan
There are a few things here that are worth mentioning. When you want to specify a range using .Range you have to specify the columns on both sides of the : ; furthermore, it takes a string. This means that what you're passing is "B1:a" which doesn't make sense to the computer because it doesn't know you want it to use the value of a instead of the letter. You need to pass "B1:B" & a to the .Range. What this does is concatenate the value you found in the variable a to the string so it appears as one string to the computer.
I personally think it's easier to take all of the values as a column vector instead of dimming the x's as a range because it makes the iteration a little easier. Instead of keeping track of what row I'm on, Counter will always tell me where I am since I'm just moving down a single column. As an added bonus, this reduces the times you access the worksheet which helps speed up your macro.
Although it's commented out, it's worth noting that the loop at the bottom of your sub wouldn't work because you haven't properly closed off the if or the for.
I'm not sure what you intended this for, but it's never a bad idea to use meaningful names so you can look back on your code and figure it out without too much effort. For example, I've renamed your a variable to lastrow which at a glance describes what value it stores.
Below your code that I've altered
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lastrow As Long
Dim Criteria As Long
Dim x() As Variant
Dim Counter As Long
lastrow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Criteria = Worksheets("Sheet1").Range("E1").Value
x = Worksheets("Sheet1").Range("B1:B" & lastrow).value
For Counter = 1 To UBound(x)
If x(Counter,1) = Criteria Then
Worksheets("Sheet1").Cells(Counter, "B").Value = "X"
End If
Next Counter
MsgBox (Criteria)
End Sub
I little bit different approach. This find the last row in column A.
I also included if you want to match by wildcard, i.e. you want to find 45 in 645.
Sub Worksheet_SelectionChange()
Dim lrow As Integer
Dim a As Integer
Dim i As String
Dim Val As String
lrow = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 'Find last row
i = Worksheets("Sheet1").Range("E1") 'Set cell where compare value is
For a = 1 To lrow 'Loop from row 1 to last row in column A
Val = Cells(a, "A").Value 'Set value to compare in Column A
'If Val Like "*" & i & "*" Then 'Use this if you want to find 45 in 645, so wildcard
If Val = i Then 'Exact match
Cells(a, "B").Value = "X" 'Put X in column B
End If
Next a
MsgBox "Match Criteria: " & (i)
End Sub
I have two worksheets in the same workbook. The first worksheet contains last periods score matrix, the second worksheet contains this periods score matrix.
I am struggling to find a away to highlight those cells in this periods worksheet that are different from last periods worksheet.
I have been able to go as far as identifying the changed cells. I know that works from use of 'MsgBoxes', however I cannot find a way to highlight the identified cells. Its probably because I have chosen to go about this the wrong way entirely. Can someone please give me a guide as to how I should go about this?
The code I have that works (according to MsgBox's anyway) is below. I would very much appreciate any guidance whatsoever.
Thanks,
Option Explicit
Sub B_HighlightDifferences()
'Workbooks("Scoring Matrix NEW").Activate
Dim varScoring As Variant
Dim varScoring_OLD As Variant
Dim strRangeToCheck As String
Dim irow As Long
Dim icol As Long
Dim color As CellFormat
strRangeToCheck = "bl9:bo15" 'smallrange for testing purposes only
varScoring = Worksheets("Scoring").Range(strRangeToCheck)
varScoring_OLD = Worksheets("Scoring_OLD").Range(strRangeToCheck)
For irow = LBound(varScoring, 1) To UBound(varScoring, 1)
For icol = LBound(varScoring, 2) To UBound(varScoring, 2)
If varScoring(irow, icol) = varScoring_OLD(irow, icol) Then
' Cells are identical. ' Do nothing.
MsgBox "This has not changed"
Else
' Cells are different.
' Need code here to highlight each cell that is different
MsgBox "This has changed"
End If
End If
Next icol
Next irow
End Sub
You did most of the hard work. I would change the following. Add:
dim newCell as Range
Application.ScreenUpdating = False
... then inside your for loop:
Set newCell = varScoring.Cells(irow, icol)
Then you should be able to apply any formatting you want to newCell (which is a Range object) when you find it's different.
newCell.Select
With Selection.Interior
.Color = 49407
' any formatting you want.
End With
At the end of your routine, turn screen updating on again:
Application.ScreenUpdating = True
Let me know if this makes sense.