ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Max Value in a column exclude selection - Excel VBA (https://www.excelbanter.com/excel-discussion-misc-queries/53753-max-value-column-exclude-selection-excel-vba.html)

magix

Max Value in a column exclude selection - Excel VBA
 
Hi,

I used the below formula to find the max value in a column, and increment it
to the selection cell.

If Application.Count(Columns(1)) Then
MaxValue = Application.Max(Columns(1))
Else
MaxValue = 0
End If

If Application.CountA(Selection) = 0 Then
Selection.Value = MaxValue + 1
Else
If MsgBox("There are values in the selection. Are you sure you want to
replace?", vbQuestion + vbYesNo) = vbYes Then
' Check OK or Cancel, If OK, replace, if Not OK, abort
Selection.Value = MaxValue + 1
End If
End If


Example:
A1 has value 1
A2 has value 1
A3 has value 2

If I select A4, and click my macro button, it will put in value 3

My concern is like this:
If I select A3, it will prompt the mesg that if I want to replace it, then
if I click yes, it will put value 3
But I want it to put value 2, so that when find the max value, it actually
find all in the column , EXCLUDE those in the selection. How can I add those
checking in finding max value in a column excluding those in selection ?

I hope you got what I mean.

Thanks.

Regards.



Dave Peterson

Max Value in a column exclude selection - Excel VBA
 
I think...

Option Explicit
Sub testme01()
Dim myRng As Range
Dim CurSel As Range
Dim myCell As Range
Dim MaxValue As Double

Set CurSel = Selection
For Each myCell In Intersect(Columns(1), ActiveSheet.UsedRange).Cells
If Intersect(myCell, CurSel) Is Nothing Then
If myRng Is Nothing Then
Set myRng = myCell
Else
Set myRng = Union(myCell, myRng)
End If
End If
Next myCell

If myRng Is Nothing Then
'can't do max!
MaxValue = 0
MsgBox MaxValue & vbLf & "no cells looked at"
Else
MaxValue = Application.Max(myRng)
MsgBox MaxValue & vbLf & myRng.Address(0, 0)
End If

'rest of your code...
'remove the msgbox's when you're happy with your tests.
End Sub


magix wrote:

Hi,

I used the below formula to find the max value in a column, and increment it
to the selection cell.

If Application.Count(Columns(1)) Then
MaxValue = Application.Max(Columns(1))
Else
MaxValue = 0
End If

If Application.CountA(Selection) = 0 Then
Selection.Value = MaxValue + 1
Else
If MsgBox("There are values in the selection. Are you sure you want to
replace?", vbQuestion + vbYesNo) = vbYes Then
' Check OK or Cancel, If OK, replace, if Not OK, abort
Selection.Value = MaxValue + 1
End If
End If

Example:
A1 has value 1
A2 has value 1
A3 has value 2

If I select A4, and click my macro button, it will put in value 3

My concern is like this:
If I select A3, it will prompt the mesg that if I want to replace it, then
if I click yes, it will put value 3
But I want it to put value 2, so that when find the max value, it actually
find all in the column , EXCLUDE those in the selection. How can I add those
checking in finding max value in a column excluding those in selection ?

I hope you got what I mean.

Thanks.

Regards.


--

Dave Peterson

magix

Max Value in a column exclude selection - Excel VBA
 

"Dave Peterson" wrote in message
...
I think...

Option Explicit
Sub testme01()
Dim myRng As Range
Dim CurSel As Range
Dim myCell As Range
Dim MaxValue As Double

Set CurSel = Selection
For Each myCell In Intersect(Columns(1), ActiveSheet.UsedRange).Cells
If Intersect(myCell, CurSel) Is Nothing Then
If myRng Is Nothing Then
Set myRng = myCell
Else
Set myRng = Union(myCell, myRng)
End If
End If
Next myCell

If myRng Is Nothing Then
'can't do max!
MaxValue = 0
MsgBox MaxValue & vbLf & "no cells looked at"
Else
MaxValue = Application.Max(myRng)
MsgBox MaxValue & vbLf & myRng.Address(0, 0)
End If

'rest of your code...
'remove the msgbox's when you're happy with your tests.
End Sub


magix wrote:

Hi,

I used the below formula to find the max value in a column, and

increment it
to the selection cell.

If Application.Count(Columns(1)) Then
MaxValue = Application.Max(Columns(1))
Else
MaxValue = 0
End If

If Application.CountA(Selection) = 0 Then
Selection.Value = MaxValue + 1
Else
If MsgBox("There are values in the selection. Are you sure you want

to
replace?", vbQuestion + vbYesNo) = vbYes Then
' Check OK or Cancel, If OK, replace, if Not OK, abort
Selection.Value = MaxValue + 1
End If
End If

Example:
A1 has value 1
A2 has value 1
A3 has value 2

If I select A4, and click my macro button, it will put in value 3

My concern is like this:
If I select A3, it will prompt the mesg that if I want to replace it,

then
if I click yes, it will put value 3
But I want it to put value 2, so that when find the max value, it

actually
find all in the column , EXCLUDE those in the selection. How can I add

those
checking in finding max value in a column excluding those in selection ?

I hope you got what I mean.

Thanks.

Regards.


--

Dave Peterson



Hi Dave,

there is a bug in this statement.
"For Each myCell In Intersect(Columns(1), ActiveSheet.UsedRange).Cells"

If currently all the cells in Column A is empty (No value), it will return
error.

Regards,
Magix




Dave Peterson

Max Value in a column exclude selection - Excel VBA
 
You can check before you loop through those cells:

Option Explicit
Sub testme01()
Dim myRng As Range
Dim CurSel As Range
Dim myCell As Range
Dim MaxValue As Double
Dim RngToCheck As Range

Set RngToCheck = Nothing
On Error Resume Next
Set RngToCheck = Intersect(Columns(1), ActiveSheet.UsedRange).Cells
On Error GoTo 0

If RngToCheck Is Nothing Then
MsgBox "Column 1 is not in the used range"
Exit Sub
End If

Set CurSel = Selection
For Each myCell In RngToCheck.Cells
If Intersect(myCell, CurSel) Is Nothing Then
If myRng Is Nothing Then
Set myRng = myCell
Else
Set myRng = Union(myCell, myRng)
End If
End If
Next myCell

If myRng Is Nothing Then
'can't do max!
MaxValue = 0
MsgBox MaxValue & vbLf & "no cells looked at"
Else
MaxValue = Application.Max(myRng)
MsgBox MaxValue & vbLf & myRng.Address(0, 0)
End If

'rest of your code...
'remove the msgbox's when you're happy with your tests.
End Sub

magix wrote:

"Dave Peterson" wrote in message
...
I think...

Option Explicit
Sub testme01()
Dim myRng As Range
Dim CurSel As Range
Dim myCell As Range
Dim MaxValue As Double

Set CurSel = Selection
For Each myCell In Intersect(Columns(1), ActiveSheet.UsedRange).Cells
If Intersect(myCell, CurSel) Is Nothing Then
If myRng Is Nothing Then
Set myRng = myCell
Else
Set myRng = Union(myCell, myRng)
End If
End If
Next myCell

If myRng Is Nothing Then
'can't do max!
MaxValue = 0
MsgBox MaxValue & vbLf & "no cells looked at"
Else
MaxValue = Application.Max(myRng)
MsgBox MaxValue & vbLf & myRng.Address(0, 0)
End If

'rest of your code...
'remove the msgbox's when you're happy with your tests.
End Sub


magix wrote:

Hi,

I used the below formula to find the max value in a column, and

increment it
to the selection cell.

If Application.Count(Columns(1)) Then
MaxValue = Application.Max(Columns(1))
Else
MaxValue = 0
End If

If Application.CountA(Selection) = 0 Then
Selection.Value = MaxValue + 1
Else
If MsgBox("There are values in the selection. Are you sure you want

to
replace?", vbQuestion + vbYesNo) = vbYes Then
' Check OK or Cancel, If OK, replace, if Not OK, abort
Selection.Value = MaxValue + 1
End If
End If

Example:
A1 has value 1
A2 has value 1
A3 has value 2

If I select A4, and click my macro button, it will put in value 3

My concern is like this:
If I select A3, it will prompt the mesg that if I want to replace it,

then
if I click yes, it will put value 3
But I want it to put value 2, so that when find the max value, it

actually
find all in the column , EXCLUDE those in the selection. How can I add

those
checking in finding max value in a column excluding those in selection ?

I hope you got what I mean.

Thanks.

Regards.


--

Dave Peterson


Hi Dave,

there is a bug in this statement.
"For Each myCell In Intersect(Columns(1), ActiveSheet.UsedRange).Cells"

If currently all the cells in Column A is empty (No value), it will return
error.

Regards,
Magix


--

Dave Peterson


All times are GMT +1. The time now is 01:17 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com