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
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
'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
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
For Each rng In Range("Q2:Q"& Rows.Count)
' code here
Next rng
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
Sorry about that but I somehow thought it was code for something else, perhaps some other column.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
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
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
Compile-error.PNG
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
Title | # Comments | Views | Activity |
---|---|---|---|
How can I sort the data shown in Sheet 1 and copy it to Sheet 2? | 8 | 26 | |
Excel - Macro hide columns not working | 4 | 20 | |
second highest value difference | 11 | 24 | |
Added a column screws up code | 5 | 15 |
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
17 Experts available now in Live!