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

E

EssKayKay

Board Regular
Joined
Jan 5, 2003
Messages
233
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

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
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

H
  • Solved
Amend the VBA code to Filter Columns Instead of Rows
Replies
9
Views
165
Akuini
Akuini
L
  • Question
Copy data from the previous upper line and paste to current row
Replies
0
Views
156
Linda Lo
L
G
  • Solved
History of Dates to be traced in Excel (2010) in DD/MM/YYYY format
2
Replies
11
Views
396
MARK858
MARK858
tabbytomo
  • Solved
Copy entire row if cell has specific value, looking at multiple columns and worksheets.
Replies
2
Views
307
NateSC
NateSC
I
  • Question
Find last row of sheet based off cell value to reference the sheet name
Replies
0
Views
194
ItalianPlatinum
I

Forum statistics

Threads
1,215,073
Messages
6,122,974
Members
449,095
Latest member
Mr Hughes

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