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

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