I have an Excel Sheet with values going in each column from cells 2:21
I need to highlight the corresponding cell in each column with the maximum value and try to loop through it with a macro. But I only know how to do it for a given hard-coded range..
Private Sub Worksheet_Activate()
Dim zelle As Range
For Each zelle In ActiveSheet.Range("B2:B21")
If zelle.Value = Application.WorksheetFunction.Max(Range("B2:B21")) Then
zelle.Interior.ColorIndex = 6
Else
zelle.Interior.ColorIndex = xlNone
End If
Next
End Sub
I tried to use a new range for column which I gave the Range ("B:IT") and iterate through that one but that didnt work.
Maybe it's just 2 or 3 lines?
This might work for you. Instead of using hard-coded ranges, it loops through whatever columns are used and adjusts for columns having different "lengths". It assumes a single header row and column.
Private Sub Worksheet_Activate()
Dim zelle As Range
Dim rng As Range
Dim lCol As Long
Dim lLastRow As Long
With ActiveSheet
For lCol = 2 To .UsedRange.Columns.Count
lLastRow = .Cells(.Rows.Count, lCol).End(xlUp).Row
Set rng = .Range(.Cells(2, lCol), .Cells(lLastRow, lCol))
For Each zelle In rng
If zelle.Value = Application.WorksheetFunction.Max(rng) Then
zelle.Interior.ColorIndex = 6
Else
zelle.Interior.ColorIndex = xlNone
End If
Next
Next lCol
End With
End Sub
An alternative way to do this is without VBA, is to
Calculate the maximum value e.g. at the bottom (=MAX(A1:A10)) and
To use conditional formatting, highlighting the cell(s) that match the result of your =MAX(A1:A10) calculations.
I know that the question referred to VBA, but this makes it dynamic and VBA independent.
Use variables:
Range(Cells(row_var_1, col_var_1),Cells(row_var_2, col_var_2))
Where row_var_1, col_var_1, row_var_2 and col_var_2 are variables that may be iterated in your loop.
Related
I understand how to use the offset function for a dynamic range, but what if that dynamic range is within a specific number of additional columns? For example, say I have a worksheet with columns A:N, and the named range refers to D2:E2. If I add two more columns, that range should expand to D2:G2, but not include columns F and onward.
I'm currently using the offset function with the counta function to do this, but there are a number of natural blank cells within this range (because of merged cells). Is there a way for me to remove these blanks for use in the combobox's dropdown?
Currently I've defined the name as:
=OFFSET('Sheet 1'!$D$2,0,0,1,COUNTA('Sheet 1'!$D2:$ZZ2))
Which returns all of the values I'm looking for, but several blanks as well that I don't want in the dropdown.
I'm currently using the following code during the userform's initialization, but this doesn't seem to be working either:
Dim Rng As Range
Dim i As Long
Me.ComboBox1.RowSource = ""
Set Rng = Range("Combo")
For i = 1 To Rng.Rows.Count
If Rng(i) <> "" Then
Me.ComboBox1.AddItem Rng(i)
End If
Next i
I've also tried
Dim aCell As Range, ws1 As Worksheet, lastColumn As Long, stopColumn As Long
Set ws1 = Worksheets("sheet 1")
With ws1
lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
stopColumn = lastColumn - 12
Me.ComboBox1.RowSource = ""
With ws1
For Each aCell In .Range("D2", .Cells(2, stopColumn))
If aCell.Value <> "" Then
Me.ComboBox1.AddItem aCell.Value
End If
Next
End With
Neither attempt has worked though, the combobox dropdown is empty.
The second part of the code above actually was functional, I was just using the wrong procedure name. I was using UserForm2, and had renamed the initialize procedure Private Sub UserForm2_Initialize() when it should have instead been `Private Sub UserForm_Initialize()
This is quite simple, I am aware, but something is going wrong for me. I simply want to subtract the values I have in column B from the values I have in column C and place these results in column Q.
I have assigned my strFormula(1) as a variant and then applied the equation to the strFormula(1). I have altered the following code from #Manhattan here on Stack Overflow :)
Sub FormulasNoLoops()
Dim strFormulas(1) As Variant
With ThisWorkbook.Sheets("Sheet1")
strFormulas(1) = "=(C2-B2)"
.Range("Q2:Q130").Formula = strFormulas
.Range("Q2:Q130").FillDown
End With
End Sub
There is no error when I run the script but also no result in column Q.
Ideally, I do not even want to enter the last cell of the column but maybe use .End(xlUp) somewhere.
Thanks all!
first
Dim strFormulas(1) As Variant
is creating an array with two items, 0,1
For one formula I would avoid the variable totally.
But if you want to use it just make it a string without the (1)
Dim strFormulas As String
Then load it:
strFormulas = "=(C2-B2)"
Also when you apply the formula to the whole range there is no need to fill down:
Sub FormulasNoLoops()
With ThisWorkbook.Sheets("Sheet1")
.Range("Q2:Q130").Formula = "=(C2-B2)"
End With
End Sub
Sub test()
Dim lastrow As Long
Dim rng As Range
last_row = ThisWorkbook.Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("C2:C" & last_row)
rng.Formula = "=B2-A2"
End Sub
I'm really new to programming and I have a spreadsheet I'm working on that I could use some help with. My Columns A and B are two dropdown menus, where B is dependent on A. There are some other columns that use VLookUp to bring up information based on the dropdown, and one other column where I have a simple formula. If I clear out a value from Column "A", I would like the entire row to clear (without losing my formulas), and i would all the cells with values under it to shift up. I've looked up a lot of ways to do this with deleting cells, but I haven't been able to find much with clearing them. My code almost works, but seems pretty inelegant since I'm using the clipboard. I also need to clear out the last row at the end using this code, but when I try it, Excel crashes. Any advice would be most appreciated. Here is my code so far:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wks As Worksheet
Dim FirstRow As Long
Dim FirstColumn As Long
Dim LastRow As Long
Dim QtyColumn As Long
Dim FormulaRange1 As Range
Dim FormulaRange2 As Range
FirstColumn = 1
QtyColumn = 4
Set wks = ActiveSheet
If Not Application.Intersect(Target, Range("A11:A26")) Is Nothing Then
If IsEmpty(Target.Value) Then
wks.Range("B" & Target.Row).ClearContents
wks.Range("D" & Target.Row).ClearContents
FirstRow = Cells(Target.Row, Target.Column).Row
LastRow = Cells(Rows.count, 1).End(xlUp).Row
Set FormulaRange1 = wks.Range(Cells(Target.Row, Target.Column).Offset(1, 0), wks.Cells(LastRow, "B"))
Set FormulaRange2 = wks.Range(Cells(Target.Row, "D").Offset(1, 0), wks.Cells(LastRow, "D"))
FormulaRange1.Copy
wks.Range(Cells(FirstRow, FirstColumn).Address).PasteSpecial xlPasteValues
FormulaRange2.Copy
wks.Range(Cells(FirstRow, QtyColumn).Address).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
End If
End Sub
I've searched for similar questions, but the problem I'm having is that I'm adding what I'm looking for to an existing recorded macro that uses commands like:
Range(Selection, Selection.End(xlUp)).Select
to select a range.
This uses the Counta function, assuming there aren't any blanks in the data. I also added IsNumeric in case the value is text. If you wanted to go a step further to make sure everything is neat, you can add this right before the If statement:
Sub Minus_One()
Dim Cell As Range
Dim Cells As Range
Set Cells = Sheets(WhateverSheet).Range("A1:A" & Application.WorksheetFunction.CountA(Range("A:A")))
For Each Cell In Cells
If IsNumeric(Cell.Value) = True Then Cell.Value = Cell.Value - 1
Next Cell
End Sub
Cell.Value = Trim(Cell.Value)
Sub test()
Dim rngTarget As Range
Set rngTarget = Sheet1.Range("A1")
Set rngTarget = Range(rngTarget, rngTarget.End(xlDown))
Dim rngIndex As Range
For Each rngIndex In rngTarget
With rngIndex
.Value = .Value - 1
End With
Next rngIndex
End Sub
Using VBA how can I select all the columns with headers in Excel? or all the columns which are not blank? Basically select all the columns with data in them.
Autofit columns with data
Sub AutoFit()
Rows("1:1").SpecialCells(xlCellTypeConstants, 23).Columns.AutoFit
End Sub
Or possibly
Sub AutoFitCell()
Cells.SpecialCells(xlCellTypeConstants, 23).Columns.AutoFit
End Sub
One easy way is to use something like range("A1").CurrentRegion.
To address the columns: range("A1").CurrentRegion.Columns.
About "selecting": this is generally useless and just slowing down your code. Never Select unless you have a serious justification for it.
Not sure if this could be useful to you, but what if you were to select all the cells that have data in them? Here's a little Macro for you, just edit the ranges to match you criteria
Sub Macro1()
Dim LR As Long, cell As Range, rng As Range
With Sheets("Sheet1")
LR = .Range("G" & Rows.Count).End(xlUp).Row
For Each cell In .Range("A1:G" & LR)
If cell.Value <> "" Then
If rng Is Nothing Then
Set rng = cell
Else
Set rng = Union(rng, cell)
End If
End If
Next cell
rng.Select
End With
End Sub