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


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