Setting up an Array on a Macro

squeakums

Well-known Member
Joined
May 15, 2007
Messages
823
Office Version
  1. 365
This is my problem. I need to setup an array to look in 408 or so names and I don't want to have to write ("billy", "beth", ... ) etc - I just want it to scan array A3:A408 instead and unsure how to write the macro to do this. Any help would be appreciated. This is what I have so far:

Sub Echo_Monthly_CSR_June()
'
' Macro8 Macro
' Macro recorded 6/21/2008 by Kelly Simcik
'

'
Windows("Monthly Macro Insert.xls").Activate
Sheets("CSR Data").Select
Dim MyArray As Variant, x As Long, c As Range

'Assuming your Source, book = Monthly Macro Insert.xls and Sheet = Copy & Paste Echo
'Also assuming your Destination, book = Monthly Macro Insert.xls and sheets = CSR Data

MyArray = Array("A3:A408").Select

For x = 0 To 405
With Workbooks("Monthly Macro Insert.xls").Sheets("Copy & Paste Echo")
Set c = .Cells.Find(What:=MyArray(x), After:=.Range("A1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If Not c Is Nothing Then
c.Offset(0, 2).Copy
Workbooks("Monthly Macro Insert.xls").Sheets("CSR Data").Range("B" & x + 3).PasteSpecial xlPasteValues
If Not c Is Nothing Then
c.Offset(0, 5).Copy
Workbooks("Monthly Macro Insert.xls").Sheets("CSR Data").Range("C" & x + 3).PasteSpecial xlPasteValues
End If
End If
End With
Next x
Range("A1").Select
Windows("Weekly Macro Insert.xls").Activate
Sheets("Supervisor Echo Results").Select
Range("B2:V28").Select
Selection.Replace What:="", Replacement:="N/A", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
Windows("Weekly Macro Insert.xls").Activate
Sheets("Macro").Select
Range("A1").Select

End Sub
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
First thing to do is to change this.
Code:
MyArray = Array("A3:A408").Select
To this.
Code:
MyArray = Workbooks("Monthly Macro Insert.xls").Sheets("CSR Data").Range("A3:A408")
You'll now have your array, albeit a 2-dimensional one.

How to proceed from there is hard to tell without further explanation of what the code is meant to do.
 
Upvote 0
Okay I have that in, but I still need to figure out the rest - any ideas anyone?
 
Upvote 0
1) change
Rich (BB code):
MyArray = Array("A3:A408").Select
to
Rich (BB code):
MyArray = Sheets("CSR Data").Range("A3:A408").Value
2) change
Rich (BB code):
For x = 0 To 405
to
Rich (BB code):
For Each e In MyArray
3) change
Rich (BB code):
Set c = .Cells.Find(What:=MyArray(x), After:=.Range("A1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
To
Rich (BB code):
Set c = .Cells.Find(What:=e, After:=.Range("A1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
4) change
Rich (BB code):
Next x
to
Rich (BB code):
Next
 
Upvote 0
The issue is that this is a huge array. That is searching for 368 names. The formula above doesn't seem to work. I tried to write something like the following:

Windows("Monthly Macro Insert.xls").Activate
Sheets("CSR Data").Select
Dim MyArray As Variant, x As Long, c As Range

'Assuming your Source, book = Monthly Macro Insert.xls and Sheet = Copy & Paste Echo
'Also assuming your Destination, book = Monthly Macro Insert.xls and sheets = CSR Da

MyArray = Array("Forename Surname",...,"LastForename LastSurname")
'The array numbered would look like this Array() so the For loop must go to 367
(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,
,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259,260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279,280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299,300,301,302,303,304,305,306,307,308,309,310,311,312,313,314,315,316,317,318,319,320,321,322,323,324,325,326,327,328,329,330,331,332,333,334,335,336,337,338,339,340,341,342,343,344,345,346,347,348,349,350,351,352,353,354,355,356,357,358,359,360,361,362,363,364,365,366,367) so the For loop must go to 367
For x = 0 To 367

But, it doesn't seem to like the excessive size ;x
 
Last edited by a moderator:
Upvote 0
squeakums

What does 'doesn't like' mean?

And why are you hard-coding all those values?

I think you really need to tell us what you are trying to achieve.:)
 
Upvote 0
Wonderful, Almost got it working!

This is what I have:

Sub Echo_Monthly_CSR_June()
'
' Macro8 Macro
' Macro recorded 6/21/2008 by Kelly Simcik
'

'
Windows("Monthly Macro Insert.xls").Activate
Sheets("CSR Data").Select
Dim MyArray As Variant, x As Long, c As Range

'Assuming your Source, book = Monthly Macro Insert.xls and Sheet = Copy & Paste Echo
'Also assuming your Destination, book = Monthly Macro Insert.xls and sheets = CSR Data

MyArray = Application.Transpose(Range("A3:A368").Value)

For x = 1 To 368
'code

With Workbooks("Monthly Macro Insert.xls").Sheets("Copy & Paste Echo")
Set c = .Cells.Find(What:=MyArray(x), After:=.Range("A1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If Not c Is Nothing Then
c.Offset(0, 2).Copy
Workbooks("Monthly Macro Insert.xls").Sheets("CSR Data").Range("c" & x + 3).PasteSpecial xlPasteValues
If Not c Is Nothing Then
c.Offset(0, 5).Copy
Workbooks("Monthly Macro Insert.xls").Sheets("CSR Data").Range("b" & x + 3).PasteSpecial xlPasteValues
End If
End If
End With
Next
Range("A1").Select
Windows("Weekly Macro Insert.xls").Activate
Sheets("Supervisor Echo Results").Select
Range("B2:V28").Select
Selection.Replace What:="", Replacement:="N/A", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
Windows("Weekly Macro Insert.xls").Activate
Sheets("Macro").Select
Range("A1").Select

End Sub

The only issue is that I am getting a script out of range error on the following:

Set c = .Cells.Find(What:=MyArray(x), After:=.Range("A1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)

Any idea why or how I can correct?

Thanks!!
 
Upvote 0
Well I want the macro to look at the CSR Data tab and use all of those names and search on the Copy & Paste Echo tab to see if it has any results for those individuals. Then I want it to take those results from the Copy & Paste Echo tab and paste it next to their name on the CSR Data tab. So, that I don't have to type in all of this manually. Does that make since?
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,974
Members
448,537
Latest member
Et_Cetera

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