Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Find Column Header By Name And Select All Data Below Column Header (Excel-VBA)

Tags:

excel

vba

I'm attempting to create a macro to do the following:

  1. Search a spreadsheet column header by name.
  2. Select all data from the selected column, except column header.
  3. Take Number Stored As Text & Convert to Number.
  • Converting to Number to use for VLookup.

For Example:

Visual Spreadsheet Example:

enter image description here

I've discovered the following code online:

With ActiveSheet.UsedRange

Set c = .Find("Employee ID", LookIn:=xlValues)

If Not c Is Nothing Then

    ActiveSheet.Range(c.Address).Offset(1, 0).Select
End If

End With

However, I'm still experiencing some issues.

like image 626
Laissez Faire Avatar asked Jun 07 '16 18:06

Laissez Faire


2 Answers

I just stumbled upon this, for me the answer was pretty straightforward, in any case If you're dealing with a ListObject then this is the way to go:

YOURLISTOBJECT.HeaderRowRange.Cells.Find("A_VALUE").Column
like image 153
Carlos_E. Avatar answered Oct 08 '22 07:10

Carlos_E.


It is good to avoid looping through all cells. If the data set grows the macro can become too slow. Using special cells and paste special operation of multiplying by 1 is an efficient way of accomplishing the task.

This works...

Dim SelRange As Range
Dim ColNum As Integer
Dim CWS As Worksheet, TmpWS As Worksheet

'Find the column number where the column header is
Set CWS = ActiveSheet
ColNum = Application.WorksheetFunction.Match("Employee ID", CWS.Rows(1), 0)

'Set the column range to work with
Set SelRange = CWS.Columns(ColNum)

'Add a worksheet to put '1' onto the clipboard, ensures no issues on activesheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Set TmpWS = ThisWorkbook.Worksheets.Add
    With TmpWS
        .Cells(1, 1) = 1
        .Cells(1, 1).Copy
    End With

    'Select none blank cells using special cells...much faster than looping through all cells
    Set SelRange = SelRange.SpecialCells(xlCellTypeConstants, 23)
    SelRange.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply
    TmpWS.Delete
    CWS.Select

Application.DisplayAlerts = True
Application.ScreenUpdating = True
like image 31
dra_red Avatar answered Oct 08 '22 07:10

dra_red