Lookin for VBA/Macro to Copy/Paste only cells in corresponding row.

E

EssKayKay

Active Member
Joined
Jan 5, 2003
Messages
417
Office Version
  1. 2007
Platform
  1. Windows
I have a spreadsheet where I want to only allow capital letters. I have Column P filled with UPPER() function where what is entered in Column M is capitalized. Example: P17 has “=UPPER(M17)” in it. This same formula is copied down 1000 rows with each P cell corresponding to the M cell in that row.

I then have a macro that copies all data in Column P to Column M with a Paste Special > Values routine. The macro is triggered with each entry in Column M via the following:

If Not Intersect(Target, Range("M:M")) Is Nothing Then
“COPY/PASTE SPECIAL” Code is placed here.
End If

This does what I want but it takes some to run with each entry in Column M. What I would like if possible is to only “Copy/Paste Special” for the two cells affected with the entry in row M. Example: If something is entered in M44 only P44 would be copied/pasted back to M44, not the entire range of M7:M1000.

I am running Excel 2007. Any suggestions would be appreciated.

Thanks,
Steve K.
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Sort by date Sort by votes
Paste in Worksheet with data.
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Target, ActiveSheet.Columns(13))
If Not rng Is Nothing Then
    Target.Value = UCase(Target.Value)
End If
End Sub
 
Upvote 0
Skyybot said:
Paste in Worksheet with data.
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Target, ActiveSheet.Columns(13))
If Not rng Is Nothing Then
    Target.Value = UCase(Target.Value)
End If
End Sub
Click to expand...
Thank you very much Skybot for your quick response. This is almost working as I was hoping. However, when I first enter (or delete) something in a cell in Column M, I receive an error message. After that all works fine, no more errors.

Error:
Run-time error ‘28’
Out of stack space

Now I probably should have mentioned that there is another routine running under “Private Sub Worksheet_Change(ByVal Target As Range)”. I placed your code at the end (after the other code). I then tried placing it first but still received the error message.

Thanks again,
Steve
 
Upvote 0
This code may be a bit convoluted but it works. I received this elsewhere (of which I am quite please.

Here's the code --

Private Sub Worksheet_Change(ByVal Target As Range)

Dim F11_Blank As String, F12_Blank As String
F11_Blank = Range("F11").Text
F12_Blank = Range("F12").Text

Dim K9_Used As String, K11_Used As String, K13_Used As String
K9_Used = Range("K9").Text
K11_Used = Range("K11").Text
K13_Used = Range("K13").Text

Dim K10_Used As Currency, K12_Used As Currency, K14_Used As Currency
K10_Used = Range("K10").Value
K12_Used = Range("K12").Value
K14_Used = Range("K14").Value

If Target.Address = "$F$11" Or Target.Address = "$F$12" Then
If F11_Blank = "" Or F12_Blank = "" Then
MsgBox "OOPS - Blank Field. . . ." & vbNewLine & vbNewLine & _
"COMPOUND PERIOD or" & vbNewLine & "PAYMENT FREQUENCY" & vbNewLine & "cannot be blank."
End If
End If

If Target.Address = "$K$9" Or Target.Address = "$K$11" Or Target.Address = "$K$13" Then
If K9_Used = " ----- " Then MsgBox " OOPS - Select open date. . . ."
If K11_Used = " ----- " Then MsgBox " OOPS - Select open date. . . ."
If K13_Used = " ----- " Then MsgBox " OOPS - Select open date. . . ."
End If

If Target.Address = "$K$10" Then
If K10_Used > 0 Then
If K9_Used = "" Then
MsgBox " OOPS -" & vbCrLf & " Must enter Date" & vbCrLf & " prior to amount. . . ."
Range("K9").Select
Else
If K9_Used = " ----- " Then
MsgBox " OOPS -" & vbCrLf & " Must enter open date" & vbCrLf & " prior to amount. . . ."
Range("K9").Select
End If
CalcIt
End If
End If
End If

If Target.Address = "$K$12" Then
If K12_Used > 0 Then
If K11_Used = "" Then
MsgBox " OOPS -" & vbCrLf & " Must enter Date" & vbCrLf & " prior to amount. . . ."
Range("K11").Select
Else
If K11_Used = " ----- " Then
MsgBox " OOPS -" & vbCrLf & " Must enter open date" & vbCrLf & " prior to amount. . . ."
Range("K11").Select
End If
CalcIt
End If
End If
End If

If Target.Address = "$K$14" Then
If K14_Used > 0 Then
If K13_Used = "" Then
MsgBox " OOPS -" & vbCrLf & " Must enter Date" & vbCrLf & " prior to amount. . . ."
Range("K13").Select
Else
If K13_Used = " ----- " Then
MsgBox " OOPS -" & vbCrLf & " Must enter open date" & vbCrLf & " prior to amount. . . ."
Range("K13").Select
End If
CalcIt
End If
End If
End If

'---------------------------------------------------------------
If Not Intersect(Target, Range("M:M")) Is Nothing Then
Dim rng As Range
Set rng = Intersect(Target, ActiveSheet.Columns(13))

If Not rng Is Nothing Then
Target.Value = UCase(Target.Value)
End If
End If
'---------------------------------------------------------------

GoodBye:
End Sub
 
Upvote 0
EssKayKay said:
This code may be a bit convoluted but it works. I received this elsewhere (of which I am quite please.

Here's the code --

Private Sub Worksheet_Change(ByVal Target As Range)

Dim F11_Blank As String, F12_Blank As String
F11_Blank = Range("F11").Text
F12_Blank = Range("F12").Text

Dim K9_Used As String, K11_Used As String, K13_Used As String
K9_Used = Range("K9").Text
K11_Used = Range("K11").Text
K13_Used = Range("K13").Text

Dim K10_Used As Currency, K12_Used As Currency, K14_Used As Currency
K10_Used = Range("K10").Value
K12_Used = Range("K12").Value
K14_Used = Range("K14").Value

If Target.Address = "$F$11" Or Target.Address = "$F$12" Then
If F11_Blank = "" Or F12_Blank = "" Then
MsgBox "OOPS - Blank Field. . . ." & vbNewLine & vbNewLine & _
"COMPOUND PERIOD or" & vbNewLine & "PAYMENT FREQUENCY" & vbNewLine & "cannot be blank."
End If
End If

If Target.Address = "$K$9" Or Target.Address = "$K$11" Or Target.Address = "$K$13" Then
If K9_Used = " ----- " Then MsgBox " OOPS - Select open date. . . ."
If K11_Used = " ----- " Then MsgBox " OOPS - Select open date. . . ."
If K13_Used = " ----- " Then MsgBox " OOPS - Select open date. . . ."
End If

If Target.Address = "$K$10" Then
If K10_Used > 0 Then
If K9_Used = "" Then
MsgBox " OOPS -" & vbCrLf & " Must enter Date" & vbCrLf & " prior to amount. . . ."
Range("K9").Select
Else
If K9_Used = " ----- " Then
MsgBox " OOPS -" & vbCrLf & " Must enter open date" & vbCrLf & " prior to amount. . . ."
Range("K9").Select
End If
CalcIt
End If
End If
End If

If Target.Address = "$K$12" Then
If K12_Used > 0 Then
If K11_Used = "" Then
MsgBox " OOPS -" & vbCrLf & " Must enter Date" & vbCrLf & " prior to amount. . . ."
Range("K11").Select
Else
If K11_Used = " ----- " Then
MsgBox " OOPS -" & vbCrLf & " Must enter open date" & vbCrLf & " prior to amount. . . ."
Range("K11").Select
End If
CalcIt
End If
End If
End If

If Target.Address = "$K$14" Then
If K14_Used > 0 Then
If K13_Used = "" Then
MsgBox " OOPS -" & vbCrLf & " Must enter Date" & vbCrLf & " prior to amount. . . ."
Range("K13").Select
Else
If K13_Used = " ----- " Then
MsgBox " OOPS -" & vbCrLf & " Must enter open date" & vbCrLf & " prior to amount. . . ."
Range("K13").Select
End If
CalcIt
End If
End If
End If

'---------------------------------------------------------------
If Not Intersect(Target, Range("M:M")) Is Nothing Then
Dim rng As Range
Set rng = Intersect(Target, ActiveSheet.Columns(13))

If Not rng Is Nothing Then
Target.Value = UCase(Target.Value)
End If
End If
'---------------------------------------------------------------

GoodBye:
End Sub
Click to expand...
Which line does the code error?
 
Upvote 0
Also, paste exactly as is. No changes. Do not nest in any other IF statements. At the end of your code. Except the declaration (Dim rng as Range) that goes at the beginning.
VBA Code: 
Dim rng As Range
Set rng = Intersect(Target, ActiveSheet.Columns(13))
If Not rng Is Nothing Then
    Target.Value = UCase(Target.Value)
End If
 
Upvote 0
Skyybot said:
Also, paste exactly as is. No changes. Do not nest in any other IF statements. At the end of your code. Except the declaration (Dim rng as Range) that goes at the beginning.
VBA Code: 
Dim rng As Range
Set rng = Intersect(Target, ActiveSheet.Columns(13))
If Not rng Is Nothing Then
    Target.Value = UCase(Target.Value)
End If
Click to expand...
When I placed the “Dim rng As Range” line at the beginning of the Worksheet_Change I still received the error message.

Here's the routine with your new code --


Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range

Dim F11_Blank As String, F12_Blank As String
F11_Blank = Range("F11").Text
F12_Blank = Range("F12").Text

Dim K9_Used As String, K11_Used As String, K13_Used As String
K9_Used = Range("K9").Text
K11_Used = Range("K11").Text
K13_Used = Range("K13").Text

Dim K10_Used As Currency, K12_Used As Currency, K14_Used As Currency
K10_Used = Range("K10").Value
K12_Used = Range("K12").Value
K14_Used = Range("K14").Value

If Target.Address = "$F$11" Or Target.Address = "$F$12" Then
If F11_Blank = "" Or F12_Blank = "" Then
MsgBox "OOPS - Blank Field. . . ." & vbNewLine & vbNewLine & _
"COMPOUND PERIOD or" & vbNewLine & "PAYMENT FREQUENCY" & vbNewLine & "cannot be blank."
End If
End If

If Target.Address = "$K$9" Or Target.Address = "$K$11" Or Target.Address = "$K$13" Then
If K9_Used = " ----- " Then MsgBox " OOPS - Select open date. . . ."
If K11_Used = " ----- " Then MsgBox " OOPS - Select open date. . . ."
If K13_Used = " ----- " Then MsgBox " OOPS - Select open date. . . ."
End If

If Target.Address = "$K$10" Then
If K10_Used > 0 Then
If K9_Used = "" Then
MsgBox " OOPS -" & vbCrLf & " Must enter Date" & vbCrLf & " prior to amount. . . ."
Range("K9").Select
Else
If K9_Used = " ----- " Then
MsgBox " OOPS -" & vbCrLf & " Must enter open date" & vbCrLf & " prior to amount. . . ."
Range("K9").Select
End If
CalcIt
End If
End If
End If

If Target.Address = "$K$12" Then
If K12_Used > 0 Then
If K11_Used = "" Then
MsgBox " OOPS -" & vbCrLf & " Must enter Date" & vbCrLf & " prior to amount. . . ."
Range("K11").Select
Else
If K11_Used = " ----- " Then
MsgBox " OOPS -" & vbCrLf & " Must enter open date" & vbCrLf & " prior to amount. . . ."
Range("K11").Select
End If
CalcIt
End If
End If
End If

If Target.Address = "$K$14" Then
If K14_Used > 0 Then
If K13_Used = "" Then
MsgBox " OOPS -" & vbCrLf & " Must enter Date" & vbCrLf & " prior to amount. . . ."
Range("K13").Select
Else
If K13_Used = " ----- " Then
MsgBox " OOPS -" & vbCrLf & " Must enter open date" & vbCrLf & " prior to amount. . . ."
Range("K13").Select
End If
CalcIt
End If
End If
End If


'---------------------------------------------------------------
Set rng = Intersect(Target, ActiveSheet.Columns(13))
If Not rng Is Nothing Then
Target.Value = UCase(Target.Value)
End If
'---------------------------------------------------------------

GoodBye:
End Sub




Sorry I am less helpful,
Steve
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
Change format of cell based on value of cell in corresponding row?
2
Replies
12
Views
506
EssKayKay
E
E
  • Solved
VBA to create range name based on value of cells in the range?
Replies
3
Views
294
SeniorNewbie
SeniorNewbie
D
  • Question Question
VBA Search a range for a value, then copy and paste data only from source to defined cells.
Replies
0
Views
104
Davion615
D
J
  • Question Question
vba to find specific text in a column and then when found copy all the rows above it
Replies
1
Views
227
mumps
mumps
Z
  • Question Question
Vba - create new sheet and copy date into it.
Replies
1
Views
111
zerofeng
Z

Forum statistics

Threads
1,224,828
Messages
6,181,204
Members
453,022
Latest member
RobertV1609

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top