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 macro 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 never 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


"broro183" wrote:

>
> 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 macro
> 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 never
> know.
>
> Hth
> Rob Brockett
> NZ
> Always learning & the best way to learn is to experience...
>
>
> --
> broro183
> ------------------------------------------------------------------------
> broro183's Profile: http://www.excelforum.com/member.php...o&userid=30068
> View this thread: http://www.excelforum.com/showthread...hreadid=521429
>
>

[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




"Blobbies" <[email protected]> wrote in message
news:[email protected]...
> 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
>
>
> "broro183" wrote:
>
>>
>> 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 macro
>> 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 never
>> know.
>>
>> Hth
>> Rob Brockett
>> NZ
>> Always learning & the best way to learn is to experience...
>>
>>
>> --
>> broro183
>> ------------------------------------------------------------------------
>> broro183's Profile:
>> http://www.excelforum.com/member.php...o&userid=30068
>> View this thread:
>> http://www.excelforum.com/showthread...hreadid=521429
>>
>>

[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



"Peo Sjoblom" wrote:

> 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
>
>
>
>
> "Blobbies" <[email protected]> wrote in message
> news:[email protected]...
> > 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
> >
> >
> > "broro183" wrote:
> >
> >>
> >> 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 macro
> >> 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 never
> >> know.
> >>
> >> Hth
> >> Rob Brockett
> >> NZ
> >> Always learning & the best way to learn is to experience...
> >>
> >>
> >> --
> >> broro183
> >> ------------------------------------------------------------------------
> >> broro183's Profile:
> >> http://www.excelforum.com/member.php...o&userid=30068
> >> View this thread:
> >> http://www.excelforum.com/showthread...hreadid=521429
> >>
> >>
>
>

[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" wrote:

>
> 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...
>
>
> --
> broro183
> ------------------------------------------------------------------------
> broro183's Profile: http://www.excelforum.com/member.php...o&userid=30068
> View this thread: http://www.excelforum.com/showthread...hreadid=521429
>
>

[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

"broro183" wrote:

>
> 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...
>
>
> --
> broro183
> ------------------------------------------------------------------------
> broro183's Profile: http://www.excelforum.com/member.php...o&userid=30068
> View this thread: http://www.excelforum.com/showthread...hreadid=521429
>
>