Establish if Offset RANGE contains text

[Mik]

I wish to establish if an offset RANGE contains text.

so, activecell and the cell below can be merged, and then populated.

something like....

if Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(1, 0)).value is
nothing then
my macro
else
my macro
end if

Can anybody please help?

 

[Dave Peterson]

if isempty(activecell.offset(1,0).value) then
'single cell under the activecell

or maybe...

if application.counta(activecell.resize(2,1)) > 0 then
'at least one of the cells (activecell or the one below it) has something
'in it

 

[Mik]

if isempty(activecell.offset(1,0).value) then
  'single cell under the activecell

or maybe...

if application.counta(activecell.resize(2,1)) > 0 then
   'at least one of the cells (activecell or the one below it) has something
   'in it










--

Dave Peterson- Hide quoted text -

- Show quoted text -

Dave,

Thanks for your responce, however, I am having problems trying to get
it working.

What I am trying to achieve is...
Cells have pulldown menu's where the user can select 'Type 2' or 'Type
3' appointments and so on...
Type 2 will occupy two cells
Type 3 will occupy three cells etc..

If a space of only 2 cells are available say 'A3:A4', because A5 may
be occupied, then the user can not enter a Type 3 appointment, as
there is insufficient space (only 2 cells available, not 3).
So, your code .... If Application.CountA(ActiveCell.Resize(2, 1)) >
0 Then ...... should determine if sufficient space is available.
Hope this makes sense.

My code (shortened, as there are 7 Case scenarios) is as follows...

Positioned within 'This Workbook'

Private Sub Workbook_sheetChange(ByVal Sh As Object, ByVal Target As
Range)

Select Case ActiveCell
Case "Type 2"
If Application.CountA(ActiveCell.Resize(2, 1)) > 0 Then
MsgBox ("Insufficient space")
Else
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(1,
0)).Select
MsgBox ("OK to continue")
End If

Case "Type 3"
If Application.CountA(ActiveCell.Resize(3, 1)) > 0 Then
MsgBox ("Insufficient space")
Else
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(2,
0)).Select
MsgBox ("OK to continue")
End If

End Select
End Sub

Hope you can assist.
Thanks in advance.
Mik

 

[Dave Peterson]

First, I would guess that you really don't want this procedure to run for each
worksheet in the workbook. (I could be wrong, though!)

Second, it's a pretty good idea to specify the range that you want to monitor.
I used A2:J2 in my code, but it could be any range you want.

Third, these events have parms passed to them. Sh and Target in the version you
posted. Sh is the sheet that has the change. Target is the cell(s) (could be
more than one!) that changed.

(If you wanted this same routine for (say) 10 out of 15 worksheets in the
workbook, you could use Sh to find out if the sheet should be processed. Post
back with more details if that's the case.)

Fourth, since you did a nice job naming the types (Type 2, Type 3, ..., Type 8),
you can extract that last number and use it in the code to find the size of the
range.

So if A2 held type 5, then you'd drop down to A3 and look at 5 cells.
Target.offset(1,0) is dropping down one.
Target.offset(1,0).resize(5,1) makes it 5 rows by 1 column.

So if all that sounds reasonable...

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myStr As String
Dim HowMany As String
Dim RngToCheck As Range

Set Target = Target.Cells(1) 'just a single cell!

'just check the changes in a specific range
'I used A2:J2, change this to match what you need
If Intersect(Target, Me.Range("A2:J2")) Is Nothing Then
Exit Sub
End If

myStr = UCase(Target.Value)

If myStr Like UCase("TYPE *") Then
'ok to continue
Else
'bad type # (this shouldn't happen, right???)
Exit Sub
End If

HowMany = Mid(myStr, 6) 'ignore the first 5 characters!

If IsNumeric(HowMany) = False Then
'not a valid option!
Exit Sub
End If

Set RngToCheck = Target.Offset(1, 0).Resize(CLng(HowMany), 1)

If Application.CountA(RngToCheck) > 0 Then
MsgBox "Insufficient space!"
Else
MsgBox "Ok to continue" 'do you really want that?
End If

End Sub

 

[Mik]

First, I would guess that you really don't want this procedure to run foreach
worksheet in the workbook.  (I could be wrong, though!)

Second, it's a pretty good idea to specify the range that you want to monitor.
I used A2:J2 in my code, but it could be any range you want.

Third, these events have parms passed to them.  Sh and Target in the version you
posted.  Sh is the sheet that has the change.  Target is the cell(s) (could be
more than one!) that changed.

(If you wanted this same routine for (say) 10 out of 15 worksheets in the
workbook, you could use Sh to find out if the sheet should be processed.  Post
back with more details if that's the case.)

Fourth, since you did a nice job naming the types (Type 2, Type 3, ..., Type 8),
you can extract that last number and use it in the code to find the size of the
range.

So if A2 held type 5, then you'd drop down to A3 and look at 5 cells.
Target.offset(1,0) is dropping down one.
Target.offset(1,0).resize(5,1) makes it 5 rows by 1 column.

So if all that sounds reasonable...

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim myStr As String
    Dim HowMany As String
    Dim RngToCheck As Range

    Set Target = Target.Cells(1) 'just a single cell!

    'just check the changes in a specific range
    'I used A2:J2, change this to match what you need
    If Intersect(Target, Me.Range("A2:J2")) Is Nothing Then
        Exit Sub
    End If

    myStr = UCase(Target.Value)

    If myStr Like UCase("TYPE *") Then
        'ok to continue
    Else
        'bad type # (this shouldn't happen, right???)
        Exit Sub
    End If

    HowMany = Mid(myStr, 6) 'ignore the first 5 characters!

    If IsNumeric(HowMany) = False Then
        'not a valid option!
        Exit Sub
    End If

    Set RngToCheck = Target.Offset(1, 0).Resize(CLng(HowMany), 1)

    If Application.CountA(RngToCheck) > 0 Then
        MsgBox "Insufficient space!"
    Else
        MsgBox "Ok to continue" 'do you really want that?
    End If

End Sub















--

Dave Peterson- Hide quoted text -

- Show quoted text -

Thanks for the reply.
I must inform you that I am a newbie, and I do not entirely understand
your code.

Answers to your initial questions...

1) I do not wish to run this code on all workshsheets. Just Sheet 1.
2) The range should be limited to B2:F36.
3) Understood.
4) The types could be kept with the name Type 1, Type 2 etc...,
however I may wish to change these names to actual appointment names,
rather than types.

I have added the code, and changed the range to B2:F6, but can't see
where i am going wrong.

Would it be possible to send you the Excel file? Or is this forbidden
on this site?
If I can send it, how is best ?

Mik

 

[Dave Peterson]

No thanks to the file.

Did you delete the code in the ThisWorkbook module?
Did you add the code to the Sheet1 module (rightclick on the worksheet tab and
select view code). Paste into that code window.

You allow "Type #" in all 175 cells (all of B2:F36)???? That seems kind of
weird to me.

If you change the values, then the code won't work. The modification could be
simple or it could be just looking through the choices.

 

[Mik]

No thanks to the file.

Did you delete the code in the ThisWorkbook module?
Did you add the code to the Sheet1 module (rightclick on the worksheet tab and
select view code).  Paste into that code window.

You allow "Type #" in all 175 cells (all of B2:F36)????  That seems kind of
weird to me.

If you change the values, then the code won't work.  The modification could be
simple or it could be just looking through the choices.












--

Dave Peterson- Hide quoted text -

- Show quoted text -

Dave,

No problem about the file.

I initially entered the code in This Workbook, now that i have entered
within the Sheet code i see that it works OK, with minor problem.

For example (below) 'Type 1' is entered in B1 and B4. The Type 1
occupies 1 cell only.
What i want to do in this example is enter 'Type 2' in cell B2. It
should fit as Type 2 would occupy 2 cells being B2:B3.
Unfortunately, the code you provided won't allow the entry of Type
2... it displays insufficient space.
Why is this? I can't see which bit of code needs changing.

A B C
1 Type 1
2 Type 2
3
4 Type 1
5
6

thanks
Mik

 

[Dave Peterson]

I screwed up. I changed your question. I was thinking that "Type 1" demanded a
single EXTRA cells under it. "Type 7" wanted 7 extra cells. (I figured your
original description couldn't possibly be correct <hehe>.)

You can just check the range you want (for example: the "type 7" cell plus the
6 under it) to see if there's exactly one cell with a value (the "Type #"
entry).

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myStr As String
Dim HowMany As String
Dim RngToCheck As Range

Set Target = Target.Cells(1) 'just a single cell!

'just check the changes in a specific range
'I used A2:J2, change this to match what you need
If Intersect(Target, Me.Range("A2:J2")) Is Nothing Then
Exit Sub
End If

myStr = UCase(Target.Value)

If myStr Like UCase("TYPE *") Then
'ok to continue
Else
'bad type # (this shouldn't happen, right???)
Exit Sub
End If

HowMany = Mid(myStr, 6) 'ignore the first 5 characters!

If IsNumeric(HowMany) = False Then
'not a valid option!
Exit Sub
End If

Set RngToCheck = Target.Resize(CLng(HowMany), 1)

If Application.CountA(RngToCheck) > 1 Then
MsgBox "Insufficient space!"
Else
MsgBox "Ok to continue" 'do you really want that?
End If

End Sub

 

[Mik]

I screwed up.  I changed your question.  I was thinking that "Type 1"demanded a
single EXTRA cells under it.  "Type 7" wanted 7 extra cells.  (I figured your
original description couldn't possibly be correct <hehe>.)

You can just check the range you want (for example:  the "type 7" cell plus the
6 under it) to see if there's exactly one cell with a value (the "Type #"
entry).

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim myStr As String
    Dim HowMany As String
    Dim RngToCheck As Range

    Set Target = Target.Cells(1) 'just a single cell!

    'just check the changes in a specific range
    'I used A2:J2, change this to match what you need
    If Intersect(Target, Me.Range("A2:J2")) Is Nothing Then
        Exit Sub
    End If

    myStr = UCase(Target.Value)

    If myStr Like UCase("TYPE *") Then
        'ok to continue
    Else
        'bad type # (this shouldn't happen, right???)
        Exit Sub
    End If

    HowMany = Mid(myStr, 6) 'ignore the first 5 characters!

    If IsNumeric(HowMany) = False Then
        'not a valid option!
        Exit Sub
    End If

    Set RngToCheck = Target.Resize(CLng(HowMany), 1)

    If Application.CountA(RngToCheck) > 1 Then
        MsgBox "Insufficient space!"
    Else
        MsgBox "Ok to continue" 'do you really want that?
    End If

End Sub







Mik wrote:








--

Dave Peterson- Hide quoted text -

- Show quoted text -

Dave,

This works great.
Thanks.

How would I perform the same task, if I were to re-label the Types?
So,
'Type 1' becomes 'Man'
'Type 2' becomes 'Exp'
'Type 3' becomes 'Fac'
etc...

Can you shed any light on this?

Thanks again.
Mik

 

[Dave Peterson]

First, you may have noticed that most responders are top posters in this forum.
(Yep, it's different here!).

You may want to start doing the same.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myStr As String
Dim HowMany As String
Dim RngToCheck As Range

Set Target = Target.Cells(1) 'just a single cell!

'just check the changes in a specific range
'I used A2:J2, change this to match what you need
If Intersect(Target, Me.Range("A2:J2")) Is Nothing Then
Exit Sub
End If

myStr = UCase(Target.Value)

'this probably would have been a good test in the other code, too.
if mystr = "" then
'the cell has been cleared
exit sub 'or something else????
end if

Select Case myStr
Case Is = UCase("man"): HowMany = 1
Case Is = UCase("Exp"): HowMany = 2
'and so on and so on
Case Else
HowMany = 0
End Select

If HowMany = 0 Then
'something bad happened, right?
Exit Sub 'or a warning or what??
End If

Set RngToCheck = Target.Resize(HowMany, 1)

If Application.CountA(RngToCheck) > 1 Then
MsgBox "Insufficient space!"
Else
MsgBox "Ok to continue" 'do you really want that?
End If

End Sub




Mik wrote:

 

[Mik]

First, you may have noticed that most responders are top posters in this forum.
(Yep, it's different here!).

You may want to start doing the same.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim myStr As String
    Dim HowMany As String
    Dim RngToCheck As Range

    Set Target = Target.Cells(1) 'just a single cell!

    'just check the changes in a specific range
    'I used A2:J2, change this to match what you need
    If Intersect(Target, Me.Range("A2:J2")) Is Nothing Then
        Exit Sub
    End If

    myStr = UCase(Target.Value)

    'this probably would have been a good test in the other code, too..
    if mystr = "" then
        'the cell has been cleared
        exit sub 'or something else????
    end if

    Select Case myStr
        Case Is = UCase("man"): HowMany = 1
        Case Is = UCase("Exp"): HowMany = 2
        'and so on and so on
        Case Else
            HowMany = 0
    End Select

    If HowMany = 0 Then
        'something bad happened, right?
        Exit Sub 'or a warning or what??
    End If

    Set RngToCheck = Target.Resize(HowMany, 1)

    If Application.CountA(RngToCheck) > 1 Then
        MsgBox "Insufficient space!"
    Else
        MsgBox "Ok to continue" 'do you really want that?
    End If

End Sub

Mik wrote:

<<Snipped>>










--

Dave Peterson- Hide quoted text -

- Show quoted text -

Dave,

Fantastic.
Does exactly what i wanted.

Appreciate your help.

Mik

 

[Dave Peterson]

But you do hate top posting!

Dave,

Fantastic.
Does exactly what i wanted.

Appreciate your help.

Mik