I have a short data range - 6 numbers - that I want to import into a spread
sheet and have them automatically sort to there respective header.
i.e.
3 5 7 12 21 33 - (no number would ever be repeated)

numbers in top row (header) from 1 to 100


I've attempted working with Macro's, thinking that would be the easiest way
to set this up, but Macros are beyond me.

TIA
John

hi Jack,

Try inserting the below code in a normal module in the file that you
want to be modified*., go to the file containing the six cells, select
the cells, press [alt + F8] to bring up a macro dialog box & select
ImportCellsBasedOnHdrRow & press [Run].

Option Explicit
Sub ImportCellsBasedOnHdrRow()
Dim rng As Range
Dim cll As Range
Dim MasterSht As Worksheet
Dim RowToUse As Long
Dim ColToUse As Long
'define the variables
Set MasterSht = ThisWorkbook.Worksheets("sheet1") 'change this to be
the file & sheet that the information is to be added to...
Set rng = Selection
'check that data is selected
If TypeName(rng) < "Range" Then GoTo Exitsub
'loop through each cell within the selection (possibly in a
separate file)
For Each cll In rng
With MasterSht
RowToUse = LastCell(MasterSht).Row
ColToUse = IdHdrColumn(.Range("1:1"), cll.Value2)
Cells(RowToUse, ColToUse).Value2 = cll.Value2
End With
Next cll
Exitsub:
Set rng = Nothing
Set MasterSht = Nothing
End Sub

Private Function IdHdrColumn(HdrRow As Range, TextToFind As String) As
Long
On Error GoTo ErrHandler
With HdrRow
IdHdrColumn = .Find(What:=TextToFind, lookat:=xlWhole,
SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
'check that the respective column has not already been
populated
If .Resize(1, 1).Offset(1, IdHdrColumn - 1).Value < "" Then
GoTo ErrHandler
End With
Exit Function
ErrHandler:
'assign the next blank column if the value is not found as a header
string
With HdrRow.Parent
IdHdrColumn = .Cells(HdrRow.Row,
Columns.Count).End(xlToLeft).Offset(0, 1).Column
End With
On Error GoTo 0
End Function

private Function LastCell(ws As Worksheet) As Range
' sourced from 'Beyond Technology :: Microsoft Excel - Identifying the
Real Last Cell' (http://www.beyondtechnology.com/geeks012.shtml)
'to identify the lastcell on a worksheet (& not necessarily the active
sheet)
Dim LastRow As Long
Dim LastCol As Long
' Error-handling is here in case there is not any
' data in the worksheet
On Error Resume Next
With ws
' Find the last real row
LastRow = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row
LastRow = Application.WorksheetFunction.Max(1, LastRow)
' Find the last real column
LastCol = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column
LastCol = Application.WorksheetFunction.Max(1, LastCol)
' Finally, initialize a Range object variable for
' the last populated row.
Set LastCell = .Cells(LastRow, LastCol)
End With
On Error GoTo 0
End Function

*Have a read of the below link for some initial understanding of
macros:
'Getting Started with Macros and User Defined Functions'
(http://www.mvps.org/dmcritchie/excel/getstarted.htm)

hth
Rob


--
broro183

Rob Brockett. Always learning & the best way to learn is to
experience...
------------------------------------------------------------------------
broro183's Profile: http://www.thecodecage.com/forumz/member.php?userid=333
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=149819

Rob,

I appreciate the help. I must be missing something as I'm getting errors -
syntax errors specifically. I will post in the morning when I'm a little more
cognizant.

Thanks again for the swift response,

John



"broro183" wrote:


hi Jack,

Try inserting the below code in a normal module in the file that you
want to be modified*., go to the file containing the six cells, select
the cells, press [alt + F8] to bring up a macro dialog box & select
ImportCellsBasedOnHdrRow & press [Run].

Option Explicit
Sub ImportCellsBasedOnHdrRow()
Dim rng As Range
Dim cll As Range
Dim MasterSht As Worksheet
Dim RowToUse As Long
Dim ColToUse As Long
'define the variables
Set MasterSht = ThisWorkbook.Worksheets("sheet1") 'change this to be
the file & sheet that the information is to be added to...
Set rng = Selection
'check that data is selected
If TypeName(rng) < "Range" Then GoTo Exitsub
'loop through each cell within the selection (possibly in a
separate file)
For Each cll In rng
With MasterSht
RowToUse = LastCell(MasterSht).Row
ColToUse = IdHdrColumn(.Range("1:1"), cll.Value2)
.Cells(RowToUse, ColToUse).Value2 = cll.Value2
End With
Next cll
Exitsub:
Set rng = Nothing
Set MasterSht = Nothing
End Sub

Private Function IdHdrColumn(HdrRow As Range, TextToFind As String) As
Long
On Error GoTo ErrHandler
With HdrRow
IdHdrColumn = .Find(What:=TextToFind, lookat:=xlWhole,
SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
'check that the respective column has not already been
populated
If .Resize(1, 1).Offset(1, IdHdrColumn - 1).Value < "" Then
GoTo ErrHandler
End With
Exit Function
ErrHandler:
'assign the next blank column if the value is not found as a header
string
With HdrRow.Parent
IdHdrColumn = .Cells(HdrRow.Row,
.Columns.Count).End(xlToLeft).Offset(0, 1).Column
End With
On Error GoTo 0
End Function

private Function LastCell(ws As Worksheet) As Range
' sourced from 'Beyond Technology :: Microsoft Excel - Identifying the
Real Last Cell' (http://www.beyondtechnology.com/geeks012.shtml)
'to identify the lastcell on a worksheet (& not necessarily the active
sheet)
Dim LastRow As Long
Dim LastCol As Long
' Error-handling is here in case there is not any
' data in the worksheet
On Error Resume Next
With ws
' Find the last real row
LastRow = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row
LastRow = Application.WorksheetFunction.Max(1, LastRow)
' Find the last real column
LastCol = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column
LastCol = Application.WorksheetFunction.Max(1, LastCol)
' Finally, initialize a Range object variable for
' the last populated row.
Set LastCell = .Cells(LastRow, LastCol)
End With
On Error GoTo 0
End Function

*Have a read of the below link for some initial understanding of
macros:
'Getting Started with Macros and User Defined Functions'
(http://www.mvps.org/dmcritchie/excel/getstarted.htm)

hth
Rob


--
broro183

Rob Brockett. Always learning & the best way to learn is to
experience...
------------------------------------------------------------------------
broro183's Profile: http://www.thecodecage.com/forumz/member.php?userid=333
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=149819

.

hi John,

It may be that some of the comments are not wrapping when being copy &
pasted into your code, or more probably, it could be that I'm using this
code in Excel 2007 & it may have some extra arguments that aren't
identified in older versions of excel.

Let us know which lines highlight when you step through the code with
the [F8] key (or try to compile it using [alt + D + L]) in the VBE.

Rob


--
broro183

Rob Brockett. Always learning & the best way to learn is to
experience...
------------------------------------------------------------------------
broro183's Profile: http://www.thecodecage.com/forumz/member.php?userid=333
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=149819

Rob,
some of the comments weren't wrapping - i think i have that sorted.
I'm using 2007

Highlighted : ActiveCell.Offset(-4, -8).Range("A1").Select

Thanks again,

John

"broro183" wrote:


hi John,

It may be that some of the comments are not wrapping when being copy &
pasted into your code, or more probably, it could be that I'm using this
code in Excel 2007 & it may have some extra arguments that aren't
identified in older versions of excel.

Let us know which lines highlight when you step through the code with
the [F8] key (or try to compile it using [alt + D + L]) in the VBE.

Rob


--
broro183

Rob Brockett. Always learning & the best way to learn is to
experience...
------------------------------------------------------------------------
broro183's Profile: http://www.thecodecage.com/forumz/member.php?userid=333
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=149819

.