|
Range Names-VBA
Hi, I need some help with drastically shortening a macro
code. I have in the region of 1000 named ranges that according to a number in a certain cell the macro would pick up the named ranges that correspond to it. I.e. If the active cell = 4126 i need ranges A & B to be picked up and pasted elsewhere. The code below would probably explain further, but as you can imagine, it would end up being a massively long code that would take me hours to write. If ActiveCell = "4126" Then Application.Goto Reference:="A_4126" Selection.Copy Sheets("Report I").Select Range("B10").Select ActiveSheet.Paste Application.Goto Reference:="B_4126" Selection.Copy Sheets("Report I").Select Range("B29").Select ActiveSheet.Paste Range("A1").Select End If If ActiveCell = "4128" Then Application.Goto Reference:="A_4128" Selection.Copy Sheets("Report I").Select Range("B10").Select ActiveSheet.Paste Application.Goto Reference:="B_4128" Selection.Copy Sheets("Report I").Select Range("B29").Select ActiveSheet.Paste Range("A1").Select End If And so on, and so on Thanking you very much in advance JOhn |
Range Names-VBA
Hi,
Assuming all your ranges are of the form "A_nnnn" and "B_nnnn" AND you call the same set of code then the following will do what you want - it removes the need for all your "IF" statements: Dim GoToRef as String GoToRef = Trim(Str(ActiveCell.Value)) Application.Goto Reference:="A_" & GoToRef Selection.Copy Sheets("Report I").Select Range("B10").Select ActiveSheet.Paste Application.Goto Reference:="B_" & GoToRef Selection.Copy Sheets("Report I").Select Range("B29").Select ActiveSheet.Paste Range("A1").Select HTH "JohnUK" wrote: Hi, I need some help with drastically shortening a macro code. I have in the region of 1000 named ranges that according to a number in a certain cell the macro would pick up the named ranges that correspond to it. I.e. If the active cell = 4126 i need ranges A & B to be picked up and pasted elsewhere. The code below would probably explain further, but as you can imagine, it would end up being a massively long code that would take me hours to write. If ActiveCell = "4126" Then Application.Goto Reference:="A_4126" Selection.Copy Sheets("Report I").Select Range("B10").Select ActiveSheet.Paste Application.Goto Reference:="B_4126" Selection.Copy Sheets("Report I").Select Range("B29").Select ActiveSheet.Paste Range("A1").Select End If If ActiveCell = "4128" Then Application.Goto Reference:="A_4128" Selection.Copy Sheets("Report I").Select Range("B10").Select ActiveSheet.Paste Application.Goto Reference:="B_4128" Selection.Copy Sheets("Report I").Select Range("B29").Select ActiveSheet.Paste Range("A1").Select End If And so on, and so on Thanking you very much in advance JOhn |
Range Names-VBA
Dim myRange As Range
Set myRange = Range("A4126,A4128,A4130") If Not Intersect(ActiveCell, myRange) Is Nothing Then ActiveCell.Copy Destination:=Range("B10") ActiveCell.Copy Destination:=Range("B29") End If Just extend myRange for all your cells -- HTH RP (remove nothere from the email address if mailing direct) "JohnUK" wrote in message ... Hi, I need some help with drastically shortening a macro code. I have in the region of 1000 named ranges that according to a number in a certain cell the macro would pick up the named ranges that correspond to it. I.e. If the active cell = 4126 i need ranges A & B to be picked up and pasted elsewhere. The code below would probably explain further, but as you can imagine, it would end up being a massively long code that would take me hours to write. If ActiveCell = "4126" Then Application.Goto Reference:="A_4126" Selection.Copy Sheets("Report I").Select Range("B10").Select ActiveSheet.Paste Application.Goto Reference:="B_4126" Selection.Copy Sheets("Report I").Select Range("B29").Select ActiveSheet.Paste Range("A1").Select End If If ActiveCell = "4128" Then Application.Goto Reference:="A_4128" Selection.Copy Sheets("Report I").Select Range("B10").Select ActiveSheet.Paste Application.Goto Reference:="B_4128" Selection.Copy Sheets("Report I").Select Range("B29").Select ActiveSheet.Paste Range("A1").Select End If And so on, and so on Thanking you very much in advance JOhn |
Range Names-VBA
Bob,
As I understood the original problem, the need was to copy a range of cells; as I understand your reply you are copying only the active cell from specific ranges e.g A4126, rather than a named range e.g A_4126. Apologies in advance if I have got this wrong. "Bob Phillips" wrote: Dim myRange As Range Set myRange = Range("A4126,A4128,A4130") If Not Intersect(ActiveCell, myRange) Is Nothing Then ActiveCell.Copy Destination:=Range("B10") ActiveCell.Copy Destination:=Range("B29") End If Just extend myRange for all your cells -- HTH RP (remove nothere from the email address if mailing direct) "JohnUK" wrote in message ... Hi, I need some help with drastically shortening a macro code. I have in the region of 1000 named ranges that according to a number in a certain cell the macro would pick up the named ranges that correspond to it. I.e. If the active cell = 4126 i need ranges A & B to be picked up and pasted elsewhere. The code below would probably explain further, but as you can imagine, it would end up being a massively long code that would take me hours to write. If ActiveCell = "4126" Then Application.Goto Reference:="A_4126" Selection.Copy Sheets("Report I").Select Range("B10").Select ActiveSheet.Paste Application.Goto Reference:="B_4126" Selection.Copy Sheets("Report I").Select Range("B29").Select ActiveSheet.Paste Range("A1").Select End If If ActiveCell = "4128" Then Application.Goto Reference:="A_4128" Selection.Copy Sheets("Report I").Select Range("B10").Select ActiveSheet.Paste Application.Goto Reference:="B_4128" Selection.Copy Sheets("Report I").Select Range("B29").Select ActiveSheet.Paste Range("A1").Select End If And so on, and so on Thanking you very much in advance JOhn |
Range Names-VBA
Hi Toppers,
As I saw it, he tested the activcell to be a cell, and then just acted upon it. Re-reading, I see he is testing the value and working on that, so maybe it should be With Range("A_" & ACtivecell.Value) .Copy Destination:=Range("B10") .Copy Destination:=Range("B29") End With even simpler :-). -- HTH RP (remove nothere from the email address if mailing direct) "Toppers" wrote in message ... Bob, As I understood the original problem, the need was to copy a range of cells; as I understand your reply you are copying only the active cell from specific ranges e.g A4126, rather than a named range e.g A_4126. Apologies in advance if I have got this wrong. "Bob Phillips" wrote: Dim myRange As Range Set myRange = Range("A4126,A4128,A4130") If Not Intersect(ActiveCell, myRange) Is Nothing Then ActiveCell.Copy Destination:=Range("B10") ActiveCell.Copy Destination:=Range("B29") End If Just extend myRange for all your cells -- HTH RP (remove nothere from the email address if mailing direct) "JohnUK" wrote in message ... Hi, I need some help with drastically shortening a macro code. I have in the region of 1000 named ranges that according to a number in a certain cell the macro would pick up the named ranges that correspond to it. I.e. If the active cell = 4126 i need ranges A & B to be picked up and pasted elsewhere. The code below would probably explain further, but as you can imagine, it would end up being a massively long code that would take me hours to write. If ActiveCell = "4126" Then Application.Goto Reference:="A_4126" Selection.Copy Sheets("Report I").Select Range("B10").Select ActiveSheet.Paste Application.Goto Reference:="B_4126" Selection.Copy Sheets("Report I").Select Range("B29").Select ActiveSheet.Paste Range("A1").Select End If If ActiveCell = "4128" Then Application.Goto Reference:="A_4128" Selection.Copy Sheets("Report I").Select Range("B10").Select ActiveSheet.Paste Application.Goto Reference:="B_4128" Selection.Copy Sheets("Report I").Select Range("B29").Select ActiveSheet.Paste Range("A1").Select End If And so on, and so on Thanking you very much in advance JOhn |
| All times are GMT +1. The time now is 10:18 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com