Got any Excel/VBA Questions? Free Excel Help
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 0 End Sub
See also:
Automatically Add Date, Time or Date & Time |
Display Excel AutoFilter Criteria |
Use AutoFilter in Excel VBA to Filter by Date & Time |
Free Training Course: Lesson 1 - Excel Fundamentals
See also: Index to Excel VBA Code; Index to Excel Freebies; Lesson 1 - Excel Fundamentals; Index to how to… providing a range of solutions
Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.