VBA - Collecting all the heading names into an array

poduk

New Member
Joined
Feb 12, 2017
Messages
23
Hi

Please can you help.

I am new to programming and maybe mixing up different languages.
The goal of my code is to collect the names of all the columns currently in my excel sheet.
The excel sheet can change in width (more or less columns) and content (heading names)


Code:
Dim i As Integer
i = 0
Range("A1").Activate  ' row 1 contains column headings
Do While Not IsEmpty(ActiveCell)  ' stop if the column heading is empty 
Heading(i) = ActiveCell.Value ' copy the heading name into array positon 0 
ActiveCell.Offset(, 1).Activate  ' move across to the next heading.
    i = i + 1 ' increase array position by 1
Loop ' loop until the end of the headings

I am hoping get an array with all column headings in it
Heading (A1, B1, C1)

Then use heading(0) to call A1 into my code.

Is it possible to do this?
If so, any idea where I am going wrong?

Thanks

Phil
 
Last edited:
More info

My code to the point it fails.
Code:
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
    "Data Source=C:\Devicies.accdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "Live_Data", cn, adOpenKeyset, adLockOptimistic, adCmdTable

' select all heading and adds to array heading

Dim heading As Variant
heading = Application.Index(Range("A1", Cells(1, Columns.Count).End(xlToLeft)).Value, 1, 0)
' end of heading grab

Range("A2").Select ' row 2 contains first record
Do While Not IsEmpty(ActiveCell) 'while there is something in column A

Dim vRecord As Variant
vRecord = Application.Index("A2", Cells(1, UBound(heading)).Value, 1, 0)

MsgBox vRecord(2)

I can see the following
Ubound(heading) picks up the value "51"
vRecord picks up "Error 2015"
MsgBox vRecord(2) display a message "Run-time error '13': Type mismatch"

I believe this is the part of my coding with the error but struggling to work out why.
Code:
vRecord = Application.Index("A2", Cells(1, UBound(heading)).Value, 1, 0)

Maybe I have not understood how Application.Index works.
Am I right in think this calls the excel command Index?
 
Upvote 0

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
I believe this is the part of my coding with the error but struggling to work out why.
Code:
vRecord = Application.Index([COLOR=#FF0000][B]Range([/B][/COLOR]"A2", Cells([COLOR=#FF0000][B]2[/B][/COLOR], UBound(heading))[COLOR=#FF0000][B])[/B][/COLOR].Value, 1, 0)
See the red changes above
 
Upvote 0
Hi Rick

Thank you again for all your help. I now have a fully working VBA code that will automatically update my Access database.

Here is a copy of the code, if it will help anyone else.


Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
    "Data Source=C:\Devicies.accdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "Live_Data", cn, adOpenKeyset, adLockOptimistic, adCmdTable

Dim heading As Variant
heading = Application.Index(Range("A1", Cells(1, Columns.Count).End(xlToLeft)).Value, 1, 0)

Dim i As Integer
i = 2

Range("A2").Select ' row 2 contains first record
Do While Not IsEmpty(ActiveCell) 'while there is something in column A

' Grab cell value of the complete row
vRecord = Application.Index(Range(ActiveCell, Cells(i, UBound(heading))).Value, 1, 0)
ActiveCell.Offset(1, 0).Activate
i = i + 1
' end - Grab cell value of the complete row
'working filter start
SerialNumber = vRecord(2) ' serial number data is in column 2
rs.Filter = "[Serial number ]='" & SerialNumber & "'"
' Working filter finish
'Updating access records
Dim v As Integer
v = 1
Do While v < UBound(heading) + 1
rs(heading(v)).Value = vRecord(v)
v = v + 1
Loop
rs.Update
' finished updating first record\row
Loop
' loop remaining rows until column a has an empty cell
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

End Sub

Phil :)
 
Upvote 0

Forum statistics

Threads
1,216,084
Messages
6,128,730
Members
449,465
Latest member
TAKLAM

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top