Vba script for automatic column detection in a table

Question

I have an excel sheet where the columns and rows of the table are changed from time to time. The affected vba script, however, uses fixed values for rows and columns. How can I find the columns and rows if they change? The name of the columns is not changed, but only the location in the sheet.

I have to upadte my method manually everytime. (Like you see in the code example)

Hello Siddharth, thank you for your detailed description. Unfortunately I do not have experience with VBA, so I can not support the integration of your code. I suspect that the return variable does not match the specified method. Here is my VBA script that needs to be extended. I hope you can help me there =)

    Option Explicit

Public Sub moduleStatus()

Dim iQZeMax As Integer
Dim iQZe As Integer
Dim iZZe As Integer
Dim iQSp As Integer
Dim shtSPR_R As Worksheet, shtAdd As Worksheet

Dim rng_2_check As Range

Dim lstLong(3) As String
lstLong(0) = "Initiated"
lstLong(1) = "Review ready"
lstLong(2) = "Reviewed"

Dim lstShort(2) As String
lstShort(0) = "Initiated"
lstShort(1) = "Review ready"

Application.EnableEvents = False
Application.ScreenUpdating = False

Set shtSPR_R = ThisWorkbook.Sheets("Report")
Set shtAdd = ThisWorkbook.Sheets("Add")

'Unprotect
shtSPR_R.Unprotect

'Clear old Data
'''shtSPR_R.Range("AB11:AB10000").ClearContents

'Status
iQSp = 28
'''iQZe = 11

'max row is determined by MA
 For iQZeMax = 10010 To 1 Step -1
If shtSPR_R.Range("A" & iQZeMax).Value <> "" Or shtSPR_R.Range("B" & iQZeMax).Value <> "" Then Exit For
Next
shtSPR_R.Range("AC11:AD10010").Clear
shtSPR_R.Range("A1").FormatConditions(1).ModifyAppliesToRange Range:=shtSPR_R.Range("A1:AE10010")

For iQZe = 11 To iQZeMax

'    If Application.WorksheetFunction.CountIfs(shtSPR_R.Range("A" & iQZe & ":AB" & iQZe), "") = iQSp Then
'        Exit For
'    End If

'Case Initiated
If shtSPR_R.Range("AB" & iQZe).Value = "" Then

    shtSPR_R.Range("AB" & iQZe).Validation.Delete
    shtSPR_R.Range("AB" & iQZe).Value = "Initiated"
    shtSPR_R.Cells(iQZe, iQSp).Validation.Add _
        Type:=xlValidateList, _
        AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, _
        Formula1:=Join(lstShort, ",")
End If

If Application.WorksheetFunction.CountIfs(shtSPR_R.Range("A9:AB9"), "Required", shtSPR_R.Range("A" & iQZe & ":AB" & iQZe), "") <> 0 Then
    shtSPR_R.Range("AB" & iQZe).Validation.Delete
    shtSPR_R.Range("AB" & iQZe).Validation.Add _
        Type:=xlValidateList, _
        AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, _
        Formula1:=Join(lstShort, ",")
Else
    shtSPR_R.Range("AB" & iQZe).Validation.Delete
    shtSPR_R.Cells(iQZe, iQSp).Validation.Add _
        Type:=xlValidateList, _
        AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, _
        Formula1:=Join(lstLong, ",")
End If

'shtSPR_R.Range("AC" & iQZe).FormulaArray = "=IFERROR(INDEX(general_report!R3C5:R10000C5,MATCH(RC[-27]&RC[-26]&RC[-22],general_report!R3C8:R10000C8&general_report!R3C2:R10000C2&general_report!R3C9:R10000C9,0)),""tbd."")"
'shtSPR_R.Range("AD" & iQZe).FormulaArray = "=IFERROR(INDEX(general_report!R3C6:R10000C6,MATCH(RC[-28]&RC[-27]&RC[-23],general_report!R3C8:R10000C8&general_report!R3C2:R10000C2&general_report!R3C9:R10000C9,0)),""tbd."")"
shtSPR_R.Range("AC" & iQZe).FormulaArray = "=IFERROR(INDEX(general_report!R4C6:R10000C6,MATCH(RC[-27]&RC[-26]&RC[-22],general_report!R4C9:R10000C9&general_report!R4C2:R10000C2&general_report!R4C10:R10000C10,0)),""tbd."")"
shtSPR_R.Range("AD" & iQZe).FormulaArray = "=IFERROR(INDEX(general_report!R4C7:R10000C7,MATCH(RC[-28]&RC[-27]&RC[-23],general_report!R4C9:R10000C9&general_report!R4C2:R10000C2&general_report!R4C10:R10000C10,0)),""tbd."")"

If shtSPR_R.Range("AB" & iQZe).Value = "Exported" Then
    shtSPR_R.Range("A" & iQZe & ":AA" & iQZe).Locked = True
Else
    shtSPR_R.Range("A" & iQZe & ":AA" & iQZe).Locked = False
End If

If shtSPR_R.Range("AE" & iQZe).Value = "" Then
    shtAdd.Range("rngSPR_ID_Cnt").Value = shtAdd.Range("rngSPR_ID_Cnt").Value + 1
    shtSPR_R.Range("AE" & iQZe).Value = shtSPR_R.Range("L" & iQZe).Value & "-" & Right("00000" & shtAdd.Range("rngSPR_ID_Cnt").Value, 5)
End If
Next iQZe

'Protect
 shtSPR_R.Protect "", DrawingObjects:=False, Contents:=True, Scenarios:=True _
            , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
            AllowFormattingRows:=True, AllowFiltering:=True


Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox "Done!"

End Sub

Hello Siddharth, i have updated my question. Could you please have a look? Thanks and best regards — user3181885, Sep 26 '18 at 06:47

Siddharth Rout · Accepted Answer · 2018-09-25T09:32:57.570

Here is another way to do it.

What you are actually trying to get is the R4C6:R10000C6 part of the formula. So what you can do is use a common sub to get the address and then create your own formula string. I am using .Find to locate the column header. To read more about .Find, you can see .Find and .FindNext

Here is an example for Linked Issues.

Option Explicit

Sub Sample()
    Debug.Print GetAddress("Linked Issues")
End Sub

Private Function GetAddress(ColHeader As String) As String
    Dim HeaderRow As Long, HeaderCol As Long
    Dim rngAddress As String: rngAddress = "Not Found"
    Dim aCell As Range
    Dim ws As Worksheet

    '~~> Change this to the relevant sheet
    Set ws = Sheet1

    With ws
        Set aCell = .Cells.Find(What:=ColHeader, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            HeaderRow = aCell.Row
            HeaderCol = aCell.Column

            rngAddress = "R" & (HeaderRow + 1) & "C" & HeaderCol & _
            ":R10000C" & HeaderCol
        End If
    End With

    GetAddress = rngAddress
End Function

CAUTION: You may get false positives if the column name is repeated elsewhere. I have used LookAt:=xlWhole to minimize that but you still need to be careful.

Screenshot:

When you run the code you will get R4C3:R10000C3

Also if you want to avoid the hardcoding of 10000, then find the last row. For that you can see THIS

Hello Siddharth, i have updated my question. Could you please have a look? Thanks and best regards — user3181885, Sep 26 '18 at 10:45

score 0 · Answer 2 · answered Sep 25 '18 at 09:04

Create a new spreadsheet, let's say "keys"

The 1st column of which will be "columns" and the 3rd of which will be rows, then you add a MATCH function, that gives you the location of the row and column, so what you'll need to do is link the VBA to keys sheet, and grab the location from there

The formula for each column:

IFERROR(ADDRESS(1,MATCH($A2,'1'!$A$1:$A$1000,0)),"missing") IFERROR(ADDRESS(MATCH($C2,'1'!$A$2:$BA$2,0),2),"missing")

And lastly, connect the formulas' results witho your VBA:

shtSPR_R.Range("keys!B2").FormulaArray = ...

Hope that helps

Vba script for automatic column detection in a table

2 Answers2