View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.misc
Peo Sjoblom
 
Posts: n/a
Default Macro to: Find a Reference, and then Paste into the 10 Rows Be

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" wrote in message
...
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