Junp start my Select Case Macro

L

L. Howard

Working with cells Range("C4:C9")'
So: if C4 = "E" then return Sheets("Sheet2").Range("C5")
if C4 = "G" then return Sheets("Sheet2").Range("D5")

and so on with S and N.

Then the same for cell C5 except I will go to Sheet3("C5")for E, G, S, N.

If you can jump start me proper coding with C4 and C5 I believe I can get the rest of the cells, C6, C7, C8 & C9.

Where each cell will have a different sheet to return from.

Thanks,
Howard


Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("C4:C9")) Is Nothing Then Exit Sub

Select Case Target.Value

Target = "E"
Target.Offset(, 1) = Sheets("Sheet2").Range("C5")

Target = "G"
Target.Offset(, 1) = Sheets("Sheet2").Range("D5")

Target = "S"
Target.Offset(, 1) = Sheets("Sheet2").Range("E5")

Target = "N"
Target.Offset(, 1) = Sheets("Sheet2").Range("F5")

Target = ""

End Select

End Sub
 
C

Claus Busch

Hi Howard,

Am Tue, 22 Apr 2014 23:48:09 -0700 (PDT) schrieb L. Howard:
Working with cells Range("C4:C9")'
So: if C4 = "E" then return Sheets("Sheet2").Range("C5")
if C4 = "G" then return Sheets("Sheet2").Range("D5")

and so on with S and N.
Click to expand...

try:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C4:C9")) Is Nothing Or _
Target.Count > 1 Then Exit Sub

Dim adr As String

Select Case UCase(Target.Value)
Case "E"
adr = "C5"
Case "G"
adr = "D5"
Case "S"
adr = "E5"
Case "N"
adr = "F5"
End Select

If Len(adr) > 0 Then
Target.Offset(, 1) = Sheets(Target.Row - 2).Range(adr)
End If
End Sub


Regards
Claus B.
 
L

L. Howard

Hi Howard,



Am Tue, 22 Apr 2014 23:48:09 -0700 (PDT) schrieb L. Howard:








try:



Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("C4:C9")) Is Nothing Or _

Target.Count > 1 Then Exit Sub



Dim adr As String



Select Case UCase(Target.Value)

Case "E"

adr = "C5"

Case "G"

adr = "D5"

Case "S"

adr = "E5"

Case "N"

adr = "F5"

End Select



If Len(adr) > 0 Then

Target.Offset(, 1) = Sheets(Target.Row - 2).Range(adr)

End If

End Sub





Regards

Claus B.

--

Vista Ultimate / Windows7

Office 2007 Ultimate / 2010 Professional
Click to expand...

Thanks Claus, that should get me going.

Howard
 
L

L. Howard

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("C4:C9")) Is Nothing Or _

Target.Count > 1 Then Exit Sub



Dim adr As String



Select Case UCase(Target.Value)

Case "E"

adr = "C5"

Case "G"

adr = "D5"

Case "S"

adr = "E5"

Case "N"

adr = "F5"

End Select



If Len(adr) > 0 Then

Target.Offset(, 1) = Sheets(Target.Row - 2).Range(adr)

End If

End Sub
Regards

Claus B.

--
Click to expand...

Claus, I am stunned!!!

That "If - Then" statement at the bottom is brilliant! Took me a bit to digest it. I was wondering how in the world you knew I had 6 sheets to draw from for my offset returns.

There is nothing more to fill out.

Thanks again.

Howard
 
C

Claus Busch

Hi Howard,

Am Wed, 23 Apr 2014 01:29:46 -0700 (PDT) schrieb L. Howard:
That "If - Then" statement at the bottom is brilliant! Took me a bit to digest it. I was wondering how in the world you knew I had 6 sheets to draw from for my offset returns.
Click to expand...

you wrote it in your explanation:

"Then the same for cell C5 except I will go to Sheet3("C5")for E, G, S,
N.
If you can jump start me proper coding with C4 and C5 I believe I can
get the rest of the cells, C6, C7, C8 & C9.
Where each cell will have a different sheet to return from."



Regards
Claus B.
 
L

L. Howard

I see, guess I explained it better than I thought.

Can you show me how I could do the same for the Range("C13:C18") within the same change event macro.

This relates to evaluating people and there will be several more ranges going down C column. I hoping if I have an example of two I can do the rest myself, but not getting anywhere in my attempts so far.

I understand this would have to be adjusted to -11 for row 13

Target.Offset(, 1) = Sheets(Target.Row - 11).Range(adr)

but the rest is giving me fits.

Howard
 
C

Claus Busch

Hi again,

Am Wed, 23 Apr 2014 03:58:06 -0700 (PDT) schrieb L. Howard:
I understand this would have to be adjusted to -11 for row 13

Target.Offset(, 1) = Sheets(Target.Row - 11).Range(adr)
Click to expand...

then try:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C4:C9, C13:C18")) Is Nothing Or _
Target.Count > 1 Then Exit Sub

Dim adr As String

Select Case UCase(Target.Value)
Case "E"
adr = "C5"
Case "G"
adr = "D5"
Case "S"
adr = "E5"
Case "N"
adr = "F5"
End Select

If Len(adr) > 0 Then
If Target.Row < 10 Then
Target.Offset(, 1) = Sheets(Target.Row - 2).Range(adr)
Else
Target.Offset(, 1) = Sheets(Target.Row - 11).Range(adr)
End If
End If
End Sub


Regards
Claus B.
 
L

L. Howard

Hi again,



Am Wed, 23 Apr 2014 03:58:06 -0700 (PDT) schrieb L. Howard:






then try:



Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("C4:C9, C13:C18")) Is Nothing Or _

Target.Count > 1 Then Exit Sub



Dim adr As String



Select Case UCase(Target.Value)

Case "E"

adr = "C5"

Case "G"

adr = "D5"

Case "S"

adr = "E5"

Case "N"

adr = "F5"

End Select



If Len(adr) > 0 Then

If Target.Row < 10 Then

Target.Offset(, 1) = Sheets(Target.Row - 2).Range(adr)

Else

Target.Offset(, 1) = Sheets(Target.Row - 11).Range(adr)

End If

End If

End Sub





Regards

Claus B.
Click to expand...

Thanks Claus, I'll see how many evaluation blocks I can add before I crash. I'm thinking I can use statements like < and/or > to define more than two evaluation blocks.

Howard
 
C

Claus Busch

Hi Howard,

Am Wed, 23 Apr 2014 09:19:22 -0700 (PDT) schrieb L. Howard:
Thanks Claus, I'll see how many evaluation blocks I can add before I crash. I'm thinking I can use statements like < and/or > to define more than two evaluation blocks.
Click to expand...

you can insert a Select Case into the
If Len(adr) > 0 Then statement:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C4:C9, C13:C18")) Is Nothing Or _
Target.Count > 1 Then Exit Sub

Dim adr As String
Dim Dif As Long

Select Case UCase(Target.Value)
Case "E"
adr = "C5"
Case "G"
adr = "D5"
Case "S"
adr = "E5"
Case "N"
adr = "F5"
End Select

If Len(adr) > 0 Then
Select Case Target.Row
Case Is < 10
Dif = 2
Case Is < 20
Dif = 11
End Select

Target.Offset(, 1) = Sheets(Target.Row - Dif).Range(adr)

End If
End Sub



Regards
Claus B.
 
G

GS

<FWIW>
I prefer to put processing code in a standard module that can be
'called' from any sheet that may need to use that same code. In this
case I'd probably do something like...

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C4:C9")) Is Nothing _
Or Target.Count > 1 Then Exit Sub
Call XferSheetData(Me, Target, Sheets(Target.Row - 2))
End Sub


In a standard module:

Sub XferSheetData(wksSrc As Worksheet, _
rngSrc As Range, wksTgt As Worksheet)
Dim sAddr$

Select Case UCase(wksSrc.rngSrc.Value)
Case "E": sAddr = "C5"
Case "G": sAddr = "D5"
Case "S": sAddr = "E5"
Case "N": sAddr = "F5"
End Select

If sAddr <> "" Then wksSrc.rngSrc.Offset(0, 1) = wksTgt.Range(sAddr)
End Sub

I might not include the actual transfer code (last executable line
above) in this procedure if I configure it as a function to return the
ref cell address. (Of course, you do know a simple LOOKUP function
would get the job done without need for VBA! Right?<g>)

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
L

L. Howard

Hi Howard,



Am Wed, 23 Apr 2014 09:19:22 -0700 (PDT) schrieb L. Howard:






you can insert a Select Case into the

If Len(adr) > 0 Then statement:



Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("C4:C9, C13:C18")) Is Nothing Or _

Target.Count > 1 Then Exit Sub



Dim adr As String

Dim Dif As Long



Select Case UCase(Target.Value)

Case "E"

adr = "C5"

Case "G"

adr = "D5"

Case "S"

adr = "E5"

Case "N"

adr = "F5"

End Select



If Len(adr) > 0 Then

Select Case Target.Row

Case Is < 10

Dif = 2

Case Is < 20

Dif = 11

End Select



Target.Offset(, 1) = Sheets(Target.Row - Dif).Range(adr)



End If

End Sub







Regards

Claus B.
Click to expand...


Here's what I did, which works.

If Len(adr) > 0 Then
If Target.Row < 10 Then
Target.Offset(, 1) = Sheets(Target.Row - 2).Range(adr)

ElseIf Target.Row > 12 And Target.Row < 19 Then
Target.Offset(, 1) = Sheets(Target.Row - 11).Range(adr)

ElseIf Target.Row > 21 And Target.Row < 28 Then
Target.Offset(, 1) = Sheets(Target.Row - 20).Range(adr)
End If
End If


I like the Len(adr) select case.

In your example it seems both cases would be true if the Row was greater than 20. So would I use a > and a < to 'capture' the rows?

Have not tried it, will do so now.

Thanks for the advice.

Howard
 
L

L. Howard

Have not tried it, will do so now.



Thanks for the advice.



Howard
Click to expand...

Hi Claus,

I found this to work well.

If Len(adr) > 0 Then

Select Case Target.Row
Case 4 To 9
Dif = 2
Case 13 To 18
Dif = 11
Case 22 To 27
Dif = 20
End Select

Target.Offset(, 1) = Sheets(Target.Row - Dif).Range(adr)
End If

Thanks.
Howard
 
C

Claus Busch

Hi Howard,

Am Wed, 23 Apr 2014 14:23:39 -0700 (PDT) schrieb L. Howard:
Select Case Target.Row
Case 4 To 9
Click to expand...

yes, that solution is more reliable


Regards
Claus B.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Deleting specific information 1
change cell color depending on two cell values 1
capture date at another sheets using Marlett 1
input info when pasted in cells 5
select case syntax to other sheets 5
Copy row info but not in normal column sequence 6
Array with many cells from a row but not in order or together 11
A simple if <> nn then Msgbox "No Match" 5

Top