Can this Macro be modified?

A

akemeny

I need the macro below to look first at Range BI6:BI137 and find blank cells,
then look at Range Y6:Y137 for the code information. Is that possible?

Sub Sonic()
With Worksheets("Oct 8 - 2054543")
For Each c In Range("y6:y137")
If c.Value = "A" Then
c.Offset(0, 36).Value = "No medical necessity for IP status; should
have been OP"
End If
If c.Value = "B" Then
c.Offset(0, 36).Value = "Admitted with presumed acute need;
Documentation and findings did not support IP status. Should have been OP
Observation"
End If
If c.Value = "C" Then
c.Offset(0, 36).Value = "No IP acuity documented; no complication
post procedure or acute intervention; should have been OP Surgery."
End If
If c.Value = "D" Then
c.Offset(0, 36).Value = "Patient does not meet IP guidelines; should
be OP observation"
End If
End With
End Sub
 
J

Joel

I like doing this using row Numbers and Select Case

Sub Sonic()
With Worksheets("Oct 8 - 2054543")
For RowCount = 6 to 137
Select Case .Range("Y" & Rowcount)
case "A":
Range("BI" & Rowcount).Value = "No medical necessity for IP status;
should
have been OP"

case "B":
Range("BI" & Rowcount).Value = "Admitted with presumed acute need;
Documentation and findings did not support IP status. Should have been OP
Observation"

case "C": Range("BI" & Rowcount).Value = "No IP acuity
documented; no complication post procedure or acute intervention; should have
been OP Surgery."

case "D":
Range("BI" & Rowcount).Value = "Patient does not meet IP guidelines;
should
be OP observation"
end select
End With
End Sub
 
D

Dave Peterson

First, if you're going to use that With/End with structure, you'll want to make
sure you prefix properties with a dot.

This code
With Worksheets("Oct 8 - 2054543")
For Each c In Range("y6:y137")

Will look thru Y6:Y137 of the active sheet (if the code is in a general module).

You'd want to use:
With Worksheets("Oct 8 - 2054543")
For Each c In .Range("y6:y137")
(notice that dot in front of Range(). That means it belongs to the object in
the previous with statement.

This is untested, but it did compile:

Option Explicit
Sub Sonic()
Dim iRow As Long
Dim wks As Worksheet
Dim myStr As String

Set wks = Worksheets("Oct 8 - 2054543")

With wks
For iRow = 6 To 137
myStr = ""
If .Cells(iRow, "B").Value = "" Then
Select Case UCase(.Cells(iRow, "Y").Value)
Case Is = "A"
myStr = "No medical necessity for IP status; " _
& "should have been OP"
Case Is = "B"
myStr = "Admitted with presumed acute need; " _
& "Documentation and findings did not " _
& "support IP status. Should have been " _
& "OP observation"
Case Is = "C"
myStr = "No IP acuity documented; no complication " _
& "post procedure or acute intervention; " _
& "should have been OP Surgery."
Case Is = "D"
myStr = "Patient does not meet IP guidelines; " _
& "should be OP observation"
End Select
If myStr = "" Then
'do nothing
Else
.Cells(iRow, "BI").Value = myStr
End If
End If
Next iRow
End With
End Sub

And did I get that column BI correct? 36 from column Y???
 
A

akemeny

The codes are the alpha letters that we use to identify which item
description will be pulled from the VBA. We enter the letter into the Y cell
and when we activate the page next time the item description will be placed
in the corresponding BI cell. However, there are times when we need to make
minor adjustments to the BI cell data (regarding dates or added information).
Thats why I need the code to look for the blank cells in BI then look for
the letter in Y before pulling the data.
 
A

akemeny

That worked perfectly. Thank you!!

Dave Peterson said:
First, if you're going to use that With/End with structure, you'll want to make
sure you prefix properties with a dot.

This code
With Worksheets("Oct 8 - 2054543")
For Each c In Range("y6:y137")

Will look thru Y6:Y137 of the active sheet (if the code is in a general module).

You'd want to use:
With Worksheets("Oct 8 - 2054543")
For Each c In .Range("y6:y137")
(notice that dot in front of Range(). That means it belongs to the object in
the previous with statement.

This is untested, but it did compile:

Option Explicit
Sub Sonic()
Dim iRow As Long
Dim wks As Worksheet
Dim myStr As String

Set wks = Worksheets("Oct 8 - 2054543")

With wks
For iRow = 6 To 137
myStr = ""
If .Cells(iRow, "B").Value = "" Then
Select Case UCase(.Cells(iRow, "Y").Value)
Case Is = "A"
myStr = "No medical necessity for IP status; " _
& "should have been OP"
Case Is = "B"
myStr = "Admitted with presumed acute need; " _
& "Documentation and findings did not " _
& "support IP status. Should have been " _
& "OP observation"
Case Is = "C"
myStr = "No IP acuity documented; no complication " _
& "post procedure or acute intervention; " _
& "should have been OP Surgery."
Case Is = "D"
myStr = "Patient does not meet IP guidelines; " _
& "should be OP observation"
End Select
If myStr = "" Then
'do nothing
Else
.Cells(iRow, "BI").Value = myStr
End If
End If
Next iRow
End With
End Sub

And did I get that column BI correct? 36 from column Y???
 
M

Mike H

Hi,

You can narrow the range down considerably with this

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wS As Worksheet
Dim MyRange as Range
Dim c As Range
For Each wS In Worksheets
If wS.Range("D1").Value = "changed" Then
lastrow = Cells(Cells.Rows.Count, "X").End(xlUp).Row
lastrow1 = Cells(Cells.Rows.Count, "BL").End(xlUp).Row
Set myrange = Range("X1:X" & WorksheetFunction.Max(lastrow, lastrow1))
For Each c In myrange
If Not c.HasFormula Then
c.Value = Trim(c.Value)
End If
Next c
End If
Next wS
ThisWorkbook.Save
End Sub

Mike
 
D

Dave Peterson

Did you mean to post this in this thread?

In any case, watch your unqualified ranges. They're going to cause trouble.
 

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

Top