Current Special! Complete Excel Excel Training Course for Excel 97 - Excel 2003, only ~~$145.00~~. $59.95 InstantBuy/Download, 30 Day Money Back Guarantee & Free Excel Help for LIFE!

Back to: Excel VBA. Got any Excel/VBA Questions? Free Excel Help

Use Array Elements To Fill a Range, Chosen By User, With Headings

Sub ArrayToTable()    Dim vArray(), vArrayHeadings()    Dim rTable As Range    Dim rCell As Range    Dim lArrayElmnt As Long    Dim lHeads As Long, lRows As Long    Dim lreply As Long, lDataCells As Long          'Fill   arrays    vArray = Array(1, 2, 3, 4, 5, 6, 7)    vArrayHeadings = Array("Head1", "Head2", "Head3", "Head4")         On Error Resume Next    Set rTable = Cells(1, 1)    Set rTable = Application.InputBox(Prompt:="Select Table Range", Type:=8)    If rTable Is Nothing Or rTable.Address = "$A$1" Then Exit Sub 'cancel or non valid range         lHeads = UBound(vArrayHeadings) + 1    lDataCells = UBound(vArray)    lRows = lDataCells / lHeads         If lHeads <> rTable.Columns.Count Then        lreply = MsgBox("Selection Range Must Have " & _        lHeads & " Columns. Try Again", vbQuestion + vbCritical + vbOKCancel)                 If lreply = vbCancel Then            Exit Sub        Else            Run "ArrayToTable"        End If    ElseIf rTable.Rows.Count <> lRows + 1 Then        lreply = MsgBox("Table Range (Including  Headings) Must Be " & _        lHeads & " Columns Wide By " & lRows + 1 & " Rows High." _        & " Try Again", vbQuestion + vbOKCancel)                 If lreply = vbCancel Then            Exit Sub        Else            Run "ArrayToTable"        End If    End If              With rTable            With .Range(Cells(1, 1), Cells(1, UBound(vArrayHeadings) + 1))                 .Value = vArrayHeadings                 .Font.Bold = True            End With        Set rTable = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)    End With         For Each rCell In rTable        rCell = vArray(lArrayElmnt)        lArrayElmnt = lArrayElmnt + 1        If lArrayElmnt = lDataCells Then Exit Sub    Next rCell         On Error GoTo 0End Sub

Excel Dashboard Reports & Excel Dashboard Charts 50% Off Become an ExcelUser Affiliate & Earn Money

Special! Free Choice of Complete Excel Training Course OR Excel Add-ins Collection on all purchases totaling over $64.00. ALLpurchases totaling over $150.00 gets you BOTH! Purchases MUST be made via this site. Send payment proof to [email protected] 31 days after purchase date.

Instant Download and Money Back Guarantee on Most Software

Try out:Analyzer XL |Downloader XL |Smart VBA |Trader XL Pro (best value) |ConsoXL | MergeXL | O2OLAP for Excel | MORE>>

Excel Trader PackageTechnical Analysis in Excel With $139.00 of FREE software!

Microsoft � and Microsoft Excel � are registered trademarks of Microsoft Corporation. OzGrid is in no way associated with Microsoft