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.

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

"Dave Peterson" <petersod@verizonXSPAM.net> wrote in message
news:436B9D0E.DBDC673A@verizonXSPAM.net...
> 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

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" <petersod@verizonXSPAM.net> wrote in message
> news:436B9D0E.DBDC673A@verizonXSPAM.net...
> > 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