Solved

Excel Macro: HELP!

Posted on 2012-03-20
19
199 Views
Last Modified: 2012-03-20
If Column Q2 has "P" in it, I want the "P" to be replaced with the physicians name that correlates with it on the same row.

It's very simple but I don't have a script for it, and I'm a noob at it.

Attached is a picture of what I what I need:

Also here is snip of the macro I need it inserted to, as you can see on the second part of the code I have no idea what to do with it:

Next


'Change Criteria Format - GOES WITH THE CODE BELOW
'=========================

Application.ScreenUpdating = False
Set rg = Intersect(Range("D:D"), ActiveSheet.UsedRange)
For Each c In rg.Cells          'Only search column D
    Select Case c.Value
        Case "1"              'Old value
            c.Value = "I"     'New value
            
        Case "2"              'Old value
            c.Value = "O"     'New value

    	Case "3"              'Old value
            c.Value = "E"     'New value

    	Case "5"              'Old value
            c.Value = "P"     'New value
            
        Case Else             'Do nothing
    End Select
Next

'????????????If P, Copy Physicians Name ??????????????????????????????????????????????????
'=========================

Application.ScreenUpdating = False
Set rg = Intersect(Range("Q:Q"), ActiveSheet.UsedRange)
For Each c In rg.Cells          'Only search column Q
    If Cells(c.Row(), 1) = "" Then Exit For '' Are we finished?
    If c.Value = "P" Then
        c.Value = "????" ------Not sure what to do??? Might be the completely wrong code
    Else
    End If
Next

Open in new window

0
Comment
Question by:Pancake_Effect
  • 10
  • 7
  • 2
19 Comments
 
LVL 45

Expert Comment

by:Martin Liss
ID: 37744544
Where is the Physician's name kept?
0
 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37744730
Sorry! Forgot to attach the screenshot.

As you can see in the SS, if it states P, it needs to be replaced by that physicians name in the row.
Example.PNG
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 37744783
Look up the Offset function. Using it you can c's value to be the value of the cell that's 2 columns to the right.
0
 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37744802
Would you happen to have an example I could use in my case? The code I'm currently using I honestly have no idea how it works, I got it graciously from other people on here. I'm just plugging in my values, but then I hit this problem where I couldn't simply plug in my values any more.

Thanks!
0
 
LVL 33

Expert Comment

by:Norie
ID: 37744818
Try this.
Set rng = Range("Q2")

While rng.Value <>"" 

        If rng.Value = "P" Then
             rng.Value = rng.offset(,2).Value
        End If

        Set rng = rng.Offset(1)
Wend

Open in new window

0
 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37744855
Okay I think I see what your trying to do, so essentially it just looks over to S "offset" if the value is P. I also added the range to be Q:Q I hope that works? I need it to search the entire column of Q.

Sorry another nooby question, how do i write that so it fits into my coding? Simply taking out the Wend and putting in a "next" didn't work for me. Again sorry I'm just a beginner trying to pick this up. I'm a network guy that got thrown a Excel project without ever doing VB in my life lol. To make matters worse I had to do this all in one week, (this is only a snip of a 30 page macro) ha

I need it plugged in below where I'll show:


'Change Criteria Format
'=========================

Application.ScreenUpdating = False
Set rg = Intersect(Range("Q:Q"), ActiveSheet.UsedRange)
For Each c In rg.Cells          'Only search column Q
    Select Case c.Value
        Case "1"              'Old value
            c.Value = "I"     'New value
            
        Case "2"              'Old value
            c.Value = "O"     'New value

        Case "3"              'Old value
            c.Value = "E"     'New value

        Case "5"              'Old value
            c.Value = "P"     'New value
            
        Case Else             'Do nothing
    End Select

Next

'Your new macro
'===================

Set Rng = Range("Q:Q")

While Rng.Value <> ""

        If Rng.Value = "P" Then
             Rng.Value = Rng.Offset(, 2).Value
        End If

        Set Rng = Rng.Offset(1)

Next '??

'Change Criteria Format
'=========================

Application.ScreenUpdating = False
Set rg = Intersect(Range("AO:AO"), ActiveSheet.UsedRange)
For Each c In rg.Cells          'Only search column AO
    If Cells(c.Row(), 1) = "" Then Exit For '' Are we finished?
    If c.Value = "CT" Then
        c.Value = "Y"
    Else
        c.Value = "N"
    End If
Next


ETC

Open in new window



I'll also attach my complete messy macro for the heck of it if you want to see it. The code I'm trying to plug your's into is towards the way bottom.
Macro-March-20th.txt
0
 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37744888
PS:

I'm just fooling around, would something like this work if fixed? It errors out on the " If Rng.Value = "P" Then" :

Next
Set rng = Range("Q2")

While rng.Value <>"" 

        If rng.Value = "P" Then
             rng.Value = rng.offset(,2).Value
        End If

        Set rng = rng.Offset(1)
end if
next

Open in new window

0
 
LVL 33

Expert Comment

by:Norie
ID: 37744890
Why not just keep the Wend?

There's no For for the next to go with anyway.

Also, the code I posted will go through the whole column, well the rows that have data.

If you really want to go through the whole column you could try this.

For Each rng In Range("Q2:Q"& Rows.Count)

' code here
Next rng

Open in new window


Might take some time though, a columns is about 65534 rows pre Excel 2007 and 1048575 rows from Excel 2007 onwards.
0
 
LVL 33

Expert Comment

by:Norie
ID: 37744894
That code won't work, and I don't understand why you want to add a Next.

In the original code there are 2 loops and this code is outwith both of them.
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37744902
Oh sorry I figured since I saw "end" it was going to stop the script there, that's why I initially changed it. Okay I just plugged in your script with a simply copy and paste and it gave no errors! I'm going to put some live data into it real quick and report back.
0
 
LVL 33

Expert Comment

by:Norie
ID: 37744970
Actually I've just looked a bit more closely at the original code, that can easily be adapted for this.
Set rg = Intersect(Range("Q:Q"), ActiveSheet.UsedRange)
For Each c In rg.Cells          'Only search column 
    If c.Value = "P" Then
        c.Value = c.Offset(,2).Value
    End If
Next

Open in new window

Sorry about that but I somehow thought it was code for something else, perhaps some other column.

By the way you could probably do this, or at least some of it, it in one loop.

You are basically looping through the same rows each time, just checking a different column.

So all you need is one loop, like this for example.
Dim rg As Range
Dim rw As Range
Dim c As Range

    Application.ScreenUpdating = False

    Set rg = ActiveSheet.UsedRange

    For Each rw In rg.Rows

        'Check column D
        Set c = Range("D" & rw.Row)
        Select Case c.Value
            Case "1"              'Old value
                c.Value = "I"     'New value

            Case "2"              'Old value
                c.Value = "O"     'New value

            Case "3"              'Old value
                c.Value = "E"     'New value

            Case "5"              'Old value
                c.Value = "P"     'New value

            Case Else             'Do nothing
        End Select


        Set c = Range("Q" & rw.Row)

        If c.Value = "P" Then
            c.Value = c.Offset(, 2).Value
        End If

        Set c = Range("AO" & rw.Row)

        If c.Value = "CT" Then
            c.Value = "Y"
        Else
            c.Value = "N"
        End If


    Next rw 

Open in new window

0
 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37744976
Edit: Just got your above message in the middle of me writing this one. I'll read it here in a second.
======
It works great! Besides one thing.

Column Q's data is actually a copy of Column D.

I use the code as essentially the last code in my huge macro...so problem is it overwrites your code. But I have a solution...have it copy BEFORE your code.

I use the code: Range("D:D").Copy Range("Q:Q")    

So in order for this all to work I need have it copy BEFORE your code, so your code applies correctly. Can you help me out how to fix this? Shown below:

Application.ScreenUpdating = False
Set rg = Intersect(Range("D:D"), ActiveSheet.UsedRange)
For Each c In rg.Cells          'Only search column D
    Select Case c.Value
        Case "1"              'Old value
            c.Value = "I"     'New value
            
        Case "2"              'Old value
            c.Value = "O"     'New value

        Case "3"              'Old value
            c.Value = "E"     'New value

        Case "5"              'Old value
            c.Value = "P"     'New value
            
        Case Else             'Do nothing
    End Select
Next
Range("D:D").Copy Range("Q:Q")  'Errors out here :(
Next  'doesn't like this next, but without it, it doesn't work, and still copies over your code
'Copy Ranges
'============


Set Rng = Range("Q2")

While Rng.Value <> ""

        If Rng.Value = "P" Then
             Rng.Value = Rng.Offset(, 2).Value
        End If

        Set Rng = Rng.Offset(1)
Wend

Open in new window

0
 
LVL 33

Expert Comment

by:Norie
ID: 37744985
How does the copy error out?
0
 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37745032
With the Next it stops on it, I have a screen shot attached showing the error.
====
Sorry I know this may be very confusing but will try to explain the best I can step by step.

Code1:  Changes numbers in Column D to either I, O, E, P
Code 2: Copies Data from Column D to Q
Code 3: Is your code which checks for the letter P then changes it to the Physician's name.

I figured if I put the code one right after the other it will do all this in order.

Problem is Code2 use to be towards the way bottom, and I need make it work in a way that works before your code.

Edit, Snip of code:
 
End Select
Next

Range("D:D").Copy Range("Q:Q") 

 'Without Next still copies over the data, which is odd. But without this code it works great! But I need it to copy then apply your code.

'Your code
'============


Set Rng = Range("Q2")

While Rng.Val

Open in new window

Compile-error.PNG
0
 
LVL 33

Accepted Solution

by:
Norie earned 500 total points
ID: 37745052
Why did you put seem to be adding Next in random places?

Did you try the last code I posted that does everything in one go?

If it's actually column D that drives what will eventually go in column Q you could do that in the Select case.

Like this, which works on the small sample dataset I've set up.
Dim rg As Range
Dim rw As Range
Dim c As Range

    Application.ScreenUpdating = False
    Set rg = ActiveSheet.UsedRange
    For Each rw In rg.Rows

        'Check column D
           'Check column D
        Set c = Range("D" & rw.Row)
        Select Case c.Value
            Case "1"              'Old value
                c.Value = "I"     'New value
                Range("Q" & rw.Row).Value = c.Value
            Case "2"              'Old value
                c.Value = "O"     'New value
                Range("Q" & rw.Row).Value = c.Value

            Case "3"              'Old value
                c.Value = "E"     'New value
                Range("Q" & rw.Row).Value = c.Value

            Case "5"              'Old value
                c.Value = "P"     'New value
                Range("Q" & rw.Row).Value = Range("S" & rw.Row).Value
        End Select

        Set c = Range("AO" & rw.Row)

        If c.Value = "CT" Then
            c.Value = "Y"
        Else
            c.Value = "N"
        End If


    Next rw

Open in new window

0
 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37745063
Yep your last code worked great all in one go, it's just the my other code "Range("D:D").Copy Range("Q:Q")" over writes it after your code works it's magic.

The reason why I don't change the D to begin with is because D needs to remain the same keeping the letter "P"

Only Q needs to have the P changed to the physicians name.
0
 
LVL 33

Expert Comment

by:Norie
ID: 37745088
Did you try the latest code I posted?

It kind of eliminates the need for copying column D to Column Q.

Rather it puts the appropriate value in D and Q, and if the value is P it puts the physician from column S in Q.
0
 
LVL 4

Author Comment

by:Pancake_Effect
ID: 37745092
Just ran your latest code it did the trick!!!
0
 
LVL 4

Author Closing Comment

by:Pancake_Effect
ID: 37745111
Again thank you so much for the help for taking the time out and helping a noobie like me with my Frankenstein code haha. You just made some transcriptionist lives much easier.
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Drop Down List with Unique/Distinct Values (enhancing the Combo-Box with a few steps and a little code) David miller (dlmille) Intro Have you ever created a data validation list from a database field or spreadsheet column (e.g., Zip Codes or Co…
Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now