Use Function on range - vba

Following my previous question:
Background Color based on difference with cell
. I would now like to apply this function to a range of rows.
The function I'd like to apply is:
If Sheets("X").Range("E18") > Sheets("blocked(R)").Range("D18") Then
Sheets("X").Range("E18").Interior.ColorIndex = 10
The range I need to apply this function to is fixed: D18:E1200.
However, there will be an active filter on this range.
The Autofill code of course is not working and writing a line of code for each of 1200 rows would be crazy.
I have been searching and reading and I think it must be something like:
Dim rng As Range
Dim row As Range
Dim cell As Range
Set rng = Range("A1:C2")
For Each row In rng.Rows
For Each cell in row.Cells
'Do Something
Next cell
Next row
But I don't seem to get it to work, I was hoping for some pointing into the right direction of the community.

Sub test()
Dim rngApply As Range
Set rngApply = Sheets("X").Range("D18:E1200")
Dim varIndex As Variant
For Each varIndex In rngApply
If varIndex.Value > Sheets("blocked(R)").Range("D18") Then
varIndex.Interior.ColorIndex = 10
End If
Next
End Sub

Related

VBA: Offset based on column headers

Is it possible to offset to the right of a cell based on column headers? I have some code that loops through a range, and if it finds a specific value it will offset 12 columns to the right. Instead of saying Offset(,12), is there a way I can say offset to the right in that same row to the column with the header I want?
For example if column B is named "host" and my range is
rng = ws.range("B1:B20")
and column N is named "country", I don't want to write:
offset(,12).value = ...
Instead if there is something like:
offset(to column: country).value =...
The reason I ask for this is to not specific an offset number to make the code more resilient to any changes that may happen to my excel worksheet.
I hope the explanation is clear. thanks!
Try the Function below, will return the number of columns you need to Offset from your Rng to the "Header" you are looking for.
Option Explicit
Function OffesttoHeader(CurrentCol As Long, FindRng As Range, HeaderStr As String) As Long
Dim HeaderRng As Range
Set HeaderRng = FindRng.Find(what:=HeaderStr)
If Not HeaderRng Is Nothing Then
OffesttoHeader = HeaderRng.Column - CurrentCol + 1
Else
OffesttoHeader = -10000 ' raise to a large value >> as an error
End If
End Function
Test Sub Code (to test the function above):
Sub Test()
Dim ws As Worksheet
Dim Rng As Range
Dim NumberofCols As Long
Set ws = ThisWorkbook.Sheets("Sheet1") ' modify to your sheet's name
Set Rng = ws.Range("B1:B20")
' pass the following parameters:
' 1. Rng.column - in your case column B = 2
' 2. ws.Rows(1) - the Range to search for the Header, first row in ws worksheet
' 3. "Header" - the Header string you are searching for
NumberofCols = OffesttoHeader(Rng.Column, ws.Rows(1), "Header")
' raise an error message box
If NumberofCols = -10000 Then
MsgBox "Unable to find Header"
End If
End Sub
In order to obtain the solution you seek above, use the Range.Find Method.
'Column Number
Dim clmCountry as Integer
From here, we want to find the header by using the Range.Find Method
'to find the header
With ThisWorkbook.Sheets("SheetName")
'update the range if necessary
clmCountry = .Range("A1:Z1").Find("HeaderName").Column
End With
Once you've found the desired column, you may offset the following way:
... Offset(RowNum, clmCountry).Value = ...
I needed to get a column value out of a row defined as a Range.
Public Function ProcessOneLine(row As Range) As String
This works for me
row.Offset(0,2).Value2 ' returns the value in Column 3
row.Offset(1,Range("C1").Column).Value2 ' also returns the value in Column
So use something like this:
Dim srcColumn as String
Dim colPosn as Integer
srcColumn = "C"
colPosn = Range(srcColumn & "1").Column
cellValue = row.Offset(0,colPosn-1).Value2

Moving Ranges in excel VBA

I need to be able to tell if a certain range of 20 cells has content, if so then move to the next 20 cells directly in the range below. Example(Sue-do): If Range(A1-B10) has items, then move to range (A11-B20). There can only be a max of 20 ranges(so 400 cells). I have code that populates these cells, but it overwrites if more than 1 item is chose to collect data from.
I think you want something like that:
dim Emptiness as boolean
dim MyRange as range, Cell1 as range
dim i as integer, j as integer
set myrange=range("A1:B10")
for i=0 to 19
j=10*i
set myrange=myrange.offset(j,0)
Emptiness=true
for each cell1 in myrange
if isempty(cell1)=false then
emptiness=false
exit for
else
emptiness=true
endif
next cell1
if emptiness=true then
'your code that populates
endif
next i
you could try this
Option Explicit
Sub main()
Dim i As Long
With Worksheets("mySheet").Range("A1:B20") <--| change "MySheet" with your actual sheet name and "A1:B20" with your actual "initial" range
For i = 0 To 19
If WorksheetFunction.CountA(.Offset(i * 20)) = 0 Then
' code to populate
' remember that ".Offset(i * 20)" will return the found 20-rows-2-columns range with no data
Exit For
End If
Next i
End With
End Sub

VBA Range.Find method not finding a value that IS in the range

I have the following method which finds the largest and smallest values in a range. I am then using those values to locate the actual cell they are in as I need to grab the value from the header cell of that column. The Range.Find is always returning Nothing even though the range being searched HAS A CELL WITH THAT VALUE.
Sub GetTopAndBottomFiveCommodities()
Dim tempRange As Range, x As Integer, bestPnL As Double, worstPnL As Double
Dim strTopRangeName As String, strBottomRangeName As String
Dim cCell As Range, commodityName As String
Set tempRange = dataSourceSheet.Range("A:A").Find(What:="Year Totals")
Set tempRange = Range(tempRange.Offset(0, 1), tempRange.End(xlToRight).Offset(0, -1))
For x = 1 To 5
strTopRangeName = "TopCommodity" & CStr(x)
strBottomRangeName = "BottomCommodity" & CStr(x)
bestPnL = WorksheetFunction.Large(tempRange, x)
worstPnL = WorksheetFunction.Small(tempRange, x)
Debug.Print tempRange.Address
' get the top commodity name and PnL
**Set cCell = tempRange.Find(What:=bestPnL, LookIn:=xlValues)**
commodityName = dataSourceSheet.Cells(5, cCell.Column).Value
Range(strTopRangeName).Value = commodityName
Range(strTopRangeName).Offset(0, 1).Value = bestPnL
Next x
End Sub
The code line
Set cCell = tempRange.Find(What:=bestPnL, LookIn:=xlValues)
is always returning nothing but I have verified that there are cells with that value. One example, the cell value is 66,152.61 (displayed in cell as 66,153) and the bestPnL variable is 66,152.61 , so I tried rounding bestPnL to 66,153, but still didn't find it. The debug statement is showing tempRange has the right range, so its not searching in the wrong place.
The only thing I can think of is the cell with the value, gets its value from a very long formula, using over a dozen named ranges, can this be fouling the find method?
Just so we all know I'm not crazy, here is a snapshot of part of the range I'm searching where I'm testing.
EDIT
Based on Tim Williams suggestion, I changed the number format of the range being searched prior to the Find call.
tempRange.NumberFormat = "0.00"
and then the Find call works as it should. I then just put the number format back the way I want it at the end of the routine.
tempRange.NumberFormat = "$#,##0;[Red]$#,##0"
Works as expected now.
Try removing the thousand separator from the number format on the cells. When I did that in a test range it worked fine, but with the separator it failed to find the value.
Set f = rng.Find(what:=bestPnL, LookIn:=xlFormulas)
will work even with the thousand separator (EDIT: only works with hard-coded values; fails with formulas).
EDIT2: this worked for me with a thousands separator and using formulas for the values (EDIT3!: does not work with currency formatting).
Sub Tester()
Dim f As Range, v, rng As Range
Set rng = Range("C3:C21")
v = Application.Large(rng, 3)
v = Format(v, rng.Cells(1).NumberFormat)
Set f = rng.Find(what:=v, LookIn:=xlValues)
Debug.Print f.Address ' >> C19
End Sub
This is an old question, but I found an alternative that can be effective and simple in some situations:
dim idx as long, rng as range
set rng = someRange
idx = application.WorksheetFunction.Match(1234,rng,0)
This will return the relative position of the FIRST 1234 valued cell in the provided range, independently of the formatting. The last 0 means you use an exact match.

VBA Excel Adjusting Row Height

I am creating a report in Excel and I would like VBA to format the row height based upon the value in column K. For example, if cell K17 = 11.25, I want row 17 to be 11.25. Cell k18 = 21.75 so row 18 =21.75.
I need vba to change every row from 17-400.
This should be relatively simple but I can't seem to come up with the correct coding.
Since this is an easy one, I went ahead and provided the answer for you:
Sub RowHeight()
Dim ws as Worksheet
Set ws = Sheets("mySheet") 'replace with your sheet name
Dim rCell as Range
For each rCell in ws.Range("K17:K400")
rCell.EntireRow.RowHeight = rCell.Value
Next
End Sub

Loop through all cells in Range using Interop

I want to loop through all cells in a range.
Dim rngTop, rngAll as Excel.Range
'Set a cell
rngTop = DirectCast(_sheet.Cells(1, 2), Excel.Range)
'Set a range from the Top cell to its last cell in the cells column
rngAll = rngTop.End(Excel.XlDirection.xlDown)
For Each cell As Excel.Range In rngAll
If cell.Value2 = "x" Then
'Do stuff
End If
Next
cell.Value is underlined and gives me the compil error that cell.value2 is an object and I cannot use an operator (= in this case) on it. Could anyone help me get this task accomplished? Value2 should not be an object.
I also tried:
Dim cell As Excel.Range = Nothing
Dim i As Integer
For i = 1 To rngAll.Rows.Count
If DirectCast(rngAll.Cells(i, 5), Excel.Range).Value2 = "x" Then
'Do stuff
End If
next i
but have the same problem as above.
I guess I have the solution. The problem here is that vb doesnt know what type value2 will deliver so it delivers an object. That is why the code give the message that the =-Operator cannot be applied. Using
If CStr(cell.value2) = "x" then
...
works perfect. So the best would be to write a function to check the valuetype for every possible type and convert it.