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

[EssKayKay]

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.

 

[EssKayKay]

I do not know what line is causing the problem - sorry.

I just noticed something else that’s weird. The first cell with an entry is M33. If I go to cell M33 and enter the same letter as the one that is there (say D with D) all works fine. However, if I enter a different letter (say G where there was a D) it will error.

I’m not sure this will work but maybe as a workaround I could write an autoexecute macro that goes to a populated cell and replace the letter in that cell with the one that is already there, then return to cursor to A1. I’m sure this is not very accepted but maybe it will work.

If this is getting too involved and I am becoming a nuisance or a pest, please feel free to disregard this posting – I’d understand.

Thanks,
Steve

 

[EssKayKay]

I just noticed something else that’s weird. The first cell with an entry is M33. If I go to cell M33 and enter the same letter as the one that is there (say D with D) all works fine. However, if I enter a different letter (say G where there was a D) it will error.

I’m not sure this will work but maybe as a workaround I could write an autoexecute macro that goes to a populated cell and replace the letter in that cell with the one that is already there, then return to cursor to A1. I’m sure this is not very accepted but maybe it will work.

If this is getting too involved and I am becoming a nuisance or a pest, please feel free to disregard this posting – I’d understand.

Thanks,
Steve

Disregard this - it's not working

 

[Skyybot]

What is CalcIt?

 

[Skyybot]

What is CalcIt?

Also, I'm thinking it might be better to use an Inputbox instead of MsgBox and Cell.Select and then Exit Sub. I think compounding Sheet changes is causing a memory error.

 

[Alex Blakenburg]

Does it make any difference if you turn enable events off and back on in @Skyybot's code ?
(I think this is the only place you are writing back to the spreadsheet, if there are other places they would need to be covered off too)

Set rng = Intersect(Target, ActiveSheet.Columns(13))
If Not rng Is Nothing Then
    Application.EnableEvents = False
    Target.Value = UCase(Target.Value)
    Application.EnableEvents = True
End If

 

[EssKayKay]

What is CalcIt?

I'm not sure what CalcIt is. I don't see any Sub or Function with that name so I temporarily removed it. Except for the same "Run-time error ‘28’ Out of stack space" error the program runs fine so I will leave it remarked out.

Also, I'm thinking it might be better to use an Inputbox instead of MsgBox and Cell.Select and then Exit Sub. I think compounding Sheet changes is causing a memory error.

 

[EssKayKay]

Does it make any difference if you turn enable events off and back on in @Skyybot's code ?
(I think this is the only place you are writing back to the spreadsheet, if there are other places they would need to be covered off too)

Set rng = Intersect(Target, ActiveSheet.Columns(13))
If Not rng Is Nothing Then
    Application.EnableEvents = False
    Target.Value = UCase(Target.Value)
    Application.EnableEvents = True
End If

I like your idea Alex. I had to modify it slightly and for the most part it works fine. Here’s what I have.

------------------------------------------------------------
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
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True

End If
End If
---------------------------------------------------------------

However, I now receive another error if I attempt to delete more than one entry in Column M. As long as I only delete one cell at a time all is fine. Deleting items in this column will probably seldom happen if ever. So, for now, maybe I’ll just leave it as is.

Thanks for your suggestion.

 

[EssKayKay]

Thank you both for your time and consideration in this matter. It is most certainly appreciated. You have been most helpful.
Steve K.

 

[Alex Blakenburg]

owever, I now receive another error if I attempt to delete more than one entry in Column M. As long as I only delete one cell at a time all is fine. Deleting items in this column will probably seldom happen if ever. So, for now, maybe I’ll just leave it as is.

This is not technically correct but seems to work and can handle multiple cell changed in Column M

    If Not Intersect(Target, Range("M:M")) Is Nothing Then
        Dim rng As Range
        Dim rCell As Range
        Set rng = Intersect(Target, ActiveSheet.Columns("M"))
    
        If Not rng Is Nothing Then
            Application.EnableEvents = False
                For Each rCell In rng
                    If rCell <> "" Then
                        rCell.Value = UCase(rCell.Value)
                    End If
                Next rCell
            Application.EnableEvents = True
        End If
    End If

 

[EssKayKay]

This is not technically correct but seems to work and can handle multiple cell changed in Column M

    If Not Intersect(Target, Range("M:M")) Is Nothing Then
        Dim rng As Range
        Dim rCell As Range
        Set rng = Intersect(Target, ActiveSheet.Columns("M"))
   
        If Not rng Is Nothing Then
            Application.EnableEvents = False
                For Each rCell In rng
                    If rCell <> "" Then
                        rCell.Value = UCase(rCell.Value)
                    End If
                Next rCell
            Application.EnableEvents = True
        End If
    End If

I made the change all appears to be fine. This program is actually for someone else so the real test will be once they start using it but for now it really looks good.

Again, I must stress - you guys are fantastic. I greatly appreciate your help.
Thank you all. . .
Steve K.