Select Cell within a range that has a maximum value - vba

I am trying to select a cell in Excel VBA 2007
Example in row 2, cells A through H have some numbers but cell B2 has the highest value. is there a formula that I could use to get the address of the cell B2 ?
Based on this, is there a way I could use a variable to select a Range(":") ?
I am a newbie to VBA so any help would be much appreciated.
Thanks

=CELL("address",INDEX(A2:H2,MATCH(MAX(A2:H2),A2:H2,0)))
EDIT.
Sub max_value_address()
Dim i As Long
i = 2
'This example assigns to A1 cell the address of max value in the range a2:h2
Range("a1").Formula = "=CELL(""Address"",INDEX(A" & i & ":H" & i & ",MATCH(MAX(A" & i & ":H" & i & "),A" & i & ":H" & i & ",0)))"
End Sub
EDIT 2.
This version is a little bit more concise.
Sub max_value_address()
Dim i As Long
Dim str As String
i = 2
str = "a" & i & ":h" & i 'assign to str a2:h2
Range("a1").Formula = "=CELL(""address"",INDEX(" & str & ",MATCH(MAX(" & str & ")," & str & ",0)))"
End Sub

The below code might help you to reach your goal. Let us know if it's unclear.
Sub GetHigherValueCellAddress()
Dim oCell As Excel.Range
Dim oRange As Excel.Range
Dim vPrevValue As Variant
Dim sAddress As String
Set oRange = Sheets(1).Range("A1:C2")
For Each oCell In oRange
If oCell.Value > vPrevValue Then
sAddress = oCell.Address
vPrevValue = oCell.Value
End If
Next oCell
MsgBox sAddress
End Sub

Related

Excel VBA: Delete multiple columns using variable containing column numbers

Because of the high chances of the arrangement of columns being adjusted in my raw data, I want to store the column numbers in variables.
I think that my syntax Columns(Variable_name) is wrong, but can't figure what will work
I tried Columns("Variable_name") which didn't work too.
Set Cws = Worksheets.Add
Cws.Name = "Ready_For_Send"
Dim Region As Integer: Region = 1
Dim Sub_Region As Integer: Sub_Region = 2
Dim User_Status As Integer: User_Status = 5
Dim Count As Integer: Count = 15
With Cws
.Range(.Columns(Region) & "," & .Columns(Sub_Region) & "," & .Columns(User_Status) & "," & Columns(Count)).Delete
End With
You can use the following:
With Cws
.Range(Cells(1, Region).EntireColumn.Address & "," _
& Cells(1, Sub_Region).EntireColumn.Address & "," _
& Cells(1, User_Status).EntireColumn.Address & "," _
& Cells(1, Count).EntireColumn.Address).Delete
End With
You can use the Union to merge all your columns to one Range, and then delete it.
Try the code below:
Dim DelRng As Range
With Cws
' Set a new range from all the columns you want to delete
Set DelRng = Union(.Columns(Region), .Columns(Sub_Region), .Columns(User_Status), .Columns(Count))
DelRng.Delete
End With
May be something like this:
Option Explicit
Sub DeleteCols()
Dim wb As Workbook
Dim Csw As Worksheet
Dim Region As Long
Dim Sub_Region As Long
Dim User_Status As Long
Dim Count As Long
Dim Cws As Worksheet
Region = 1
Sub_Region = 2
User_Status = 5
Count = 15
Set wb = ThisWorkbook
Application.DisplayAlerts = False
On Error Resume Next
Set Cws = wb.Worksheets.Add
Cws.Name = "Ready_For_Send"
On Error GoTo 0
Application.DisplayAlerts = True
With Cws
.Range( _
ReturnName(Region) & ":" & ReturnName(Region) & "," & _
ReturnName(Sub_Region) & ":" & ReturnName(Sub_Region) & "," & _
ReturnName(User_Status) & ":" & ReturnName(User_Status) & "," & _
ReturnName(Count) & ":" & ReturnName(Count) _
).Delete Shift:=xlToLeft
End With
End Sub
Function ReturnName(ByVal num As Integer) As String
ReturnName = Split(Cells(, num).Address, "$")(1)
End Function
Some structure and Function from here: Delete multiple columns
I have included error handling in case sheet already exists. Also full declarations. I have also put declarations and assignments on different lines for ease of reading.

Correcting formula in vba excel

I want to create a macro that check all the cells of a column and if the first two characters of a cell is "BB" then i want the macro to extract three characters from the cell and paste it to the next column but a the corresponding row.
But my formula after the if clause is not working.
this is what i have done since:
Sub test()
Dim lmid As String
Dim srange, SelData, ExtBbFor As String
Dim lastrow As Long
Dim i, icount As Integer
lastrow = ActiveSheet.Range("B30000").End(xlUp).Row
srange = "G1:G" & lastrow
SelData = "A1:G" & lastrow
Range(srange).Formula = "=mid(E1,1,3)"
For i = 1 To lastrow
If InStr(1, LCase(Range("E" & i)), "bb") <> 0 Then
Range("G" & i).Formula = "=mid("E & i", 4, 3)"
End If
Next i
End Sub
thanks in advance
Try with below. It will work
Range("G" & i).Value = Mid(Range("E" & i), 4, 3)
If the cell is not limited to 7 then you need as below
Range("G" & i).Value = "=Mid(E" & i & ", 3, " & Len(E & "& i & ") & ")"
It will extract from the 3rd character up to the last character in a cell.
Your syntax is wrong where you're trying to concatenate strings, I think you mean to use:
Range("G" & i).Formula = "=MID(E" & i & ",4,3)"
Based on your code I think this will do the exact same thing without having to loop or declare any variables:
Sub test()
With Range("G1:G" & Cells(Rows.Count, 2).End(xlUp).Row)
.FormulaR1C1 = "=IF(UPPER(LEFT(RC[-2],2))=""BB"",MID(RC[-2],4,3),"""")"
.Value = .Value
End With
End Sub

macro to check non blank cells in a column to ensure isdate()

I've been looking to write a macro to check 3 columns to ensure the contents are a date value. The columns can contain empty cells.
The below returns a message box for each cell that is not a date, even the blanks.
Sub DateCheck()
With ActiveSheet
lastRow = .Range("AB" & Rows.Count).End(xlUp).Row
For RowCount = 2 To lastRow
POC = .Range("AB" & RowCount)
If Not IsDate(POC) Then
MsgBox ("Please enter valid date in Cell : AB" & RowCount & ". Example: dd/mm/yyyy")
End If
Next RowCount
End With
End Sub
Could anybody be so kind as to help to adjust this to look at 3 non-adjacent columns, ignore blank cells and only return one message per column in the event it finds non-date values?
Thanks as always
Chris
Code:
Sub DateCheck()
Dim s(2) As String
Dim i As Integer
Dim o As String
Dim lastRow As Long
Dim r As Long
'Enter columns here:
s(0) = "A"
s(1) = "B"
s(2) = "C"
For i = 0 To 2
With ActiveSheet
lastRow = .Range(s(i) & Rows.Count).End(xlUp).Row
For r = 2 To lastRow
POC = .Range(s(i) & r)
If Not IsDate(POC) Then
o = o & ", " & .Range(s(i) & r).Address
End If
Next r
MsgBox ("Please enter valid date in Cells : " & Right(o, Len(o) - 1) & ". Example: dd/mm/yyyy")
o = ""
End With
Next i
End Sub
I would change your loop to a For Each In ... Next and use .Union to construct a range of non-adjacent columns.
Sub MultiDateCheck()
Dim lr As Long, cl As Range, rng As Range, mssg As String
With ActiveSheet
lr = .Range("AB" & Rows.Count).End(xlUp).Row
Set rng = Union(.Range("AB2:AB" & lr), .Range("AM2:AM" & lr), .Range("AZ2:AZ" & lr))
For Each cl In rng
If Not IsDate(cl.Value) And Not IsEmpty(cl) Then _
mssg = mssg & cl.Address(0, 0) & Space(4)
Next cl
End With
If CBool(Len(mssg)) Then
MsgBox ("Please enter valid date(s) in Cell(s): " & Chr(10) & Chr(10) & _
mssg & Chr(10) & Chr(10) & _
"Example: dd/mm/yyyy")
Else
MsgBox "All dates completed!"
End If
Set rng = Nothing
End Sub
I've used a single lastrow from column AB to determined the scope of the cells to be examined but individual rows for each column could easily be compensated for.
Addendum: Code modified for a single message showing rogue non-date/non-blank cells (as below). The Chr(10) is simply a line feed character.
                     

SUM formula VBA

I am trying to calculate the sum of changing cell range in vba. Unfortunately the cell values are variables. I can't seem to get the following formula to work.
Private Sub calcOverheadRate(startCell As Integer, endCell As Integer)
Total = endCell + 1
Range("D" & Total).Formula = "=SUM("D" & startCell & ":" & "D" & endCell)"
End Sub
I get compile error: "Expected: end of statement
To solve this problem I changed the function to,
Private Sub calcOverheadRate(startCell As Integer, endCell As Integer)
Dim start As String
Dim endC As String
start = "D" & CStr(startCell)
endC = "D" & CStr(endCell)
Total = endCell + 1
Range("D" & Total).Formula = "=SUM(start:endC)"
End Sub
The function compiles fine, when I run it, the value in the cell is "#NAME" where it references SUM(start:endC) not SUM(D5:D23)....
Any thoughts on how to solve this would be appreciated.
The quotes are the issue:
Range("D" & Total).Formula = "=SUM(" & startCell & ":" & endCell & ")"
I have figured out the problem the & needs to be inside the quotation for string literals
Range("D" & Total).Formula = "=SUM(" & start & ":" & endC & ")"
How about you try using a table?
Here is a 1 min video on how to make a table in Excel:
http://www.screenr.com/VvZ8

Copying multiple ranges and concatenating them in Excel

My Excel sheet has multiple used ranges. I want to copy each range value and concatenate them. What I did is
Set tempRange = Union(SrcWkb.Worksheets("mysheet").Range("F1:H1"), SrcWkb.Worksheets("mysheet").Range("I1:J1"), SrcWkb.Worksheets("NWP").Range("K1:L1"))
For Each eachRange In tempRange
tempString = tempString & eachRange & "/"
MsgBox tempString
Next eachRange
I want to copy the value in merged cells F1:H1 and concatenate a "/" and value from I1:J1 (also merged) and K1 to L1. However, Excel throws "subscript out of range" error. How could I achieve this?
It is not quite clear from your original post what output you need. Here is one option which may help you get started:
Sub ConcatRanges()
Dim rangeOne As Range, rangeTwo As Range, rangeAll As Range, cl As Range, str As String
Set rangeOne = Worksheets("mysheet").Range("I27:K27")
Set rangeTwo = Worksheets("mysheet").Range("L27:N27")
Set rangeAll = Union(rangeOne, rangeTwo)
For Each cl In rangeAll
str = str & cl & " / "
Next cl
Debug.Print str //Output: 1 / 2 / 3 / 4 / 5 / 6 /
End Sub
Updated Post
Dealing with merged ranges can be tricky. For example, the merged range F1:H1 has value 36M. To access the value you have to refer to the first cell in the merged range. Example:
Sub MergedRangeDemo()
Dim rng As Range, cl As Range
Set rng = ActiveSheet.Range("F1:H1")
For Each cl In rng
Debug.Print cl.Value, cl.Address
Next cl
//Output: 36M $F$1 <-- Only first cell contains the value
// $G$1
// $H$1
End Sub
Given this you can concatenate the values by using the rowindex (1) of the range:
Sub ConcatRangesUpdated()
Dim rangeOne As Range, rangeTwo As Range, rangeThree As Range, str As String
Set rangeOne = ActiveSheet.Range("F1:H1")
Set rangeTwo = ActiveSheet.Range("I1:J1")
Set rangeThree = ActiveSheet.Range("K1:L1")
str = rangeOne(1) & " / " & rangeTwo(1) & " / " & rangeThree(1)
Debug.Print str 'Output: 36M / 40M / 36M
End Sub
It appears that you want to concatenate I27 and L27 with a forward slash between and put the results on a different worksheet. This example does just that: concatenates I27 & L27, J27 & M27, K27 & N27 and puts the results in cells A27:C27 on the destination sheet. Note that the formula uses R1C1 notation with relative column positions; adjust as necessary.
Sub ConcatCells()
Dim sSource As String
sSource = "'" & SrcWkb.Worksheets("mysheet").Name & "'!"
DstWks1.Range("A27:C27").FormulaR1C1 = "=" & sSource & "RC[8] & " _
& Chr$(34) & "/" & Chr$(34) & " & " & sSource & "RC[11]"
End Sub