Importing Data with Dynamic Columns (VBA)

[Glasgowsmile]

Good day,

I'm trying to come up with VBA code to import a few columns of data from an exported spreadsheet. The challenge is that the amount of columns and even the columns the data end up in are subject to change each time the report is pulled. There is 1 consistent factor though that I think I can use to pull the remaining data.

Each time the sheet is exported there is a header above the columns that are merged across all the columns I need to pull. "Rate Heading" is the header for that, so how would I write VBA to specifically find the Rate Heading section of the report and then pull all the data below that merged column?

Currently, this is what I'm working with which I pulled from another report I have that needed something similar but not as complex.

Sub DiscountPer()
   Application.DisplayAlerts = False
   
   Dim Fnd As Range
   Dim Hrg As Range
   Dim wkbCrntWorkBook As Workbook
   Dim wkbSourceBook As Workbook
   
   Set wkbCrntWorkBook = ActiveWorkbook
   
   With Application.FileDialog(msoFileDialogOpen)
      .Filters.Clear
      .Filters.Add "CSV Files", "*.csv"
      .AllowMultiSelect = False
      .Show
      
      If .SelectedItems.Count > 0 Then
        Set wkbSourceBook = Workbooks.Open(.SelectedItems(1))
        Set Fnd = Range("A1:AG1").Find("Rate Heading", , , xlPart, , , False, , False)
        Range(Fnd.Offset(1), Range("N2000")).Copy
        wkbCrntWorkBook.Sheets("RC1").Range("A1").PasteSpecial xlPasteValues
        wkbCrntWorkBook.Sheets("RC1").Range("A1").Value = ActiveSheet.Range("B13").Value
        wkbSourceBook.Close False
      End If

 

[Oddball2020]

Good day,

I'm trying to come up with VBA code to import a few columns of data from an exported spreadsheet. The challenge is that the amount of columns and even the columns the data end up in are subject to change each time the report is pulled. There is 1 consistent factor though that I think I can use to pull the remaining data.

Each time the sheet is exported there is a header above the columns that are merged across all the columns I need to pull. "Rate Heading" is the header for that, so how would I write VBA to specifically find the Rate Heading section of the report and then pull all the data below that merged column?

Currently, this is what I'm working with which I pulled from another report I have that needed something similar but not as complex.

Sub DiscountPer()
   Application.DisplayAlerts = False
 
   Dim Fnd As Range
   Dim Hrg As Range
   Dim wkbCrntWorkBook As Workbook
   Dim wkbSourceBook As Workbook
 
   Set wkbCrntWorkBook = ActiveWorkbook
 
   With Application.FileDialog(msoFileDialogOpen)
      .Filters.Clear
      .Filters.Add "CSV Files", "*.csv"
      .AllowMultiSelect = False
      .Show
  
      If .SelectedItems.Count > 0 Then
        Set wkbSourceBook = Workbooks.Open(.SelectedItems(1))
        Set Fnd = Range("A1:AG1").Find("Rate Heading", , , xlPart, , , False, , False)
        Range(Fnd.Offset(1), Range("N2000")).Copy
        wkbCrntWorkBook.Sheets("RC1").Range("A1").PasteSpecial xlPasteValues
        wkbCrntWorkBook.Sheets("RC1").Range("A1").Value = ActiveSheet.Range("B13").Value
        wkbSourceBook.Close False
      End If

Use this code to find "Rate Header" in Row 1. Change it as needed (RTH can be whatever you want)

Dim RTH as Long
RTH = WorksheetFunction.Match("Rate Header", Rows(1), 0)

This will return the column number that matches Rate Header. Then use that to copy such as

Columns(RTH).Copy

Or say if it was 2 more columns beyond Rate Header you wanted to copy as well,

Range(Columns(RTH), Columns(RTH+2)).Copy

Or if it was just a subset range in those columns,

Range(Cells(2,RTH), Cells(100, RTH+2)).Copy

.... which is using Cells(Rows,Columns) format.... so Range("A1") = Cells(1,1).... or Range("B4") = Cells(4, 2) .... Range("A1:B4") = Range(Cells(1,1), Cells(4,2)) etc this is handy and easier in VBA to use numbers derived from the MATCH function above, and preferred when making VBA dynamic such as in your case with a floating header

then paste as normal wherever

Similar for looking down a column,

WHERERU = WorksheetFunction.Match("Find Me", Columns(1), 0)

Sometimes merged cells though gives VBA fits when trying to do things like copying