Macro to: Find a Reference, and then Paste into the 10 Rows Below

[Blobbies]

I receive peoples' Sports Picks via email, from a 3rd party form processor.

I then copy their picks, go to Excel and execute this Macro: (Just recorded
with the Macro Recorder)

Application.Goto Reference:="R68C72"
ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= _
False
Selection.TextToColumns Destination:=Range("BT68"),
DataType:=xlFixedWidth _
, FieldInfo:=Array(Array(0, 1), Array(6, 1)),
TrailingMinusNumbers:=True
Range("BU68:BU77").Select
Range("BU68:BU77").Activate
Selection.Copy


What I would dearly love it to do is:

* Look up the reference in BU77
* Find that in the range J67:BB67
* Paste into rows 68-77 below where it finds that reference.

If someone could also insert some code to automatically click "OK" when the
dialog asking "Do you want to replace the contents of the destination cells?"
into the "Text to Columns" code above, that would be like heaven!!

Thanks for your time and attention!


Eddie

 

[broro183]

Hi Eddie,

The below code should do what you are after.
The line "Application.DisplayAlerts = False" & the matching ..."true
should stop the popup from the text to column code.

Sub Test()
Dim ReferenceValue As String
Dim Headers As Range
Set Headers = Range("J67:BB67")
Dim ReferenceColumn As Long

Application.Goto Reference:="R68C72", Scroll:=True
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:
_
False
Selection.TextToColumns Destination:=Range("BT68")
DataType:=xlFixedWidth _
, FieldInfo:=Array(Array(0, 1), Array(6, 1))
TrailingMinusNumbers:=True
ReferenceValue = Range("bu77")
Application.DisplayAlerts = True
On Error GoTo ErrorMessage
ReferenceColumn = Headers.Find(What:=ReferenceValue, After:=ActiveCell
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext
_
MatchCase:=False, SearchFormat:=False).Column

Range("BU68:BU77").Copy Cells(68, ReferenceColumn)
Application.ScreenUpdating = True
Exit Sub
ErrorMessage:
MsgBox "The value in BU77 is not one of the headers therefore macr
ending!" & Chr(13) & Chr(13) & "The error is:" & chr(13) & Error
Application.ScreenUpdating = True
End Sub

btw, the error message is probably not needed but then again, you neve
know.

Hth
Rob Brockett
NZ
Always learning & the best way to learn is to experience..

 

[Blobbies]

Hi Rob

Nice to see a fellow kiwi!!

Some of your code turns red in my system - I've pasted it below and have
placed 2 asterisks at the start and finish of the stuff that is red.

Any suggestions? I do appreciate your help, and am pleased to say that I've
now manged to get rid of the Alert box, with your help!!


Sub Test()
Dim ReferenceValue As String
Dim Headers As Range
Set Headers = Range("J67:BB67")
Dim ReferenceColumn As Long

Application.Goto Reference:="R68C72", Scroll:=True
Application.ScreenUpdating = False
Application.DisplayAlerts = False
**ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=
_
False
Selection.TextToColumns Destination:=Range("BT68"),
DataType:=xlFixedWidth _
, FieldInfo:=Array(Array(0, 1), Array(6, 1)),
TrailingMinusNumbers:=True**
ReferenceValue = Range("bu77")
Application.DisplayAlerts = True
On Error GoTo ErrorMessage
**ReferenceColumn = Headers.Find(What:=ReferenceValue, After:=ActiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
_
MatchCase:=False, SearchFormat:=False).Column**

Range("BU68:BU77").Copy Cells(68, ReferenceColumn)
Application.ScreenUpdating = True
Exit Sub
ErrorMessage:
MsgBox "The value in BU77 is not one of the headers therefore macro"
**ending!" & Chr(13) & Chr(13) & "The error is:" & chr(13) & Error**
Application.ScreenUpdating = True
End Sub

 

[Peo Sjoblom]

You have line wrapping, for instance

ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=
_
False


should be either

ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= _
False

or all on one line without the underscore

ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= False

you can do the same with the other lines,






--

Regards,

Peo Sjoblom

Northwest Excel Solutions

www.nwexcelsolutions.com

(remove ^^ from email address)

Portland, Oregon

 

[broro183]

Hi Eddie,
Yep, it's nice to see a fellow Kiwi
Peo's suggestion should help you out with the line wrapping - Thanks
Peo.

Rob Brockett
NZ
Always learning & the best way to learn is to experience...

 

[Blobbies]

Thanks Peo

The next problem is that I', getting an error message I execute it, saying:
"Runtime error 13 - Type Mismatch"

When I click on Debug, it comes up with this line highlighted:
"ReferenceColumn = Headers.Find(What:=ReferenceValue, After:=ActiveCell,
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Column"

I imagine it's something I've done wrong - sorry for being so dopey!!

And thanks for any help!




Eddie

 

[broro183]

Hi Eddie,

Sorry, this isn't as trouble free as I would have liked - I don't know
why the "mismatch" error is occurring. The macro worked for me when I
tested before posting it but wasn't interested in working when I tried
again after seeing your response, if the below doesn't work hopefully
Peo or someone else can explain the problem to both of us.

I changed the ReferenceColumn line to...
ReferenceColumn = Headers.Find(What:=ReferenceValue, MatchCase:=False,
SearchFormat:=False).Column

I don't know why but removing the other arguments seems to allow this
to work.

hth
Rob Brockett
NZ
Always learning & the bes way to learn is to experience...

 

[Blobbies]

thanks rob (& peo)

i appreciate your efforts!

as you can probably tell, i enjoy using excel, but am not clever enough to
work out these macros! i can kinda see how they work, but am not familiar
enough with them to work out exactly what you've done!

cheers!!

 

[broro183]

Hi Eddie,
Thanks for the feedback.
I hope it works now, does it?
If not, there are a couple of other ways we could work around the
problem -let us know.

"as you can probably tell, i enjoy using excel, but am not clever
enough to
work out these macros! i can kinda see how they work, but am not
familiar
enough with them to work out exactly what you've done!"

I enjoy using Excel too & am sure you are clever enough to work these
out - you're right it is just familiarity, remember you are effectively
learning another language & this takes time.
18 months ago I didn't even know macros existed & it was just over a
year ago that someone showed me the "insides" of one & that there is
such a thing as a "macro recorder"!
If you want to get better just keeping playing/experimenting & reading
solutions to other people's questions, as I say in my signature...

Rob Brockett
NZ
Always learning & the best way to learn is to experience...

 

[Blobbies]

cheers rob

i will keep playing - am up too late already tonight, mucking around with my
fifa football world cup picks spreadsheet!

and you're right, mucking around with it is the best way to learn!

thanks for your help!!


eddie