Export data based on column name

[swartzfeger]

Hi all, I have (very) limited programming skills and need a simple way to export data based on column name (the column will always be named "Missing #"). I found some VBA that would do the trick with one caveat -- there will always be a different number of columns in this worksheet, so the range of A1:?? will always be different. In the example below, the range is A1:P1... I need a way to determine the actual range for a given sheet. Would something like Range.End or Range.Find be useful?

Also, in the procedure below it simply selects the columns named "Missing #"... is there a way to export the data from the Missing # columns without writing another procedure?

Thanks!

Sub FindMissing()
'11/14/2022
    Dim xRg As Range
    Dim xRgUni As Range
    Dim xFirstAddress As String
    Dim xStr As String
    On Error Resume Next
    xStr = "Missing #"
    Set xRg = Range("A1:P1").Find(xStr, , xlValues, xlWhole, , , True)
    If Not xRg Is Nothing Then
        xFirstAddress = xRg.Address
        Do
            Set xRg = Range("A1:P1").FindNext(xRg)
            If xRgUni Is Nothing Then
                Set xRgUni = xRg
            Else
                Set xRgUni = Application.Union(xRgUni, xRg)
            End If
        Loop While (Not xRg Is Nothing) And (xRg.Address <> xFirstAddress)
    End If
    xRgUni.EntireColumn.Select
End Sub

 

[mumps]

so the range of A1:?? will always be different.

Try changing:

Set xRg = Range("A1:P1").FindNext(xRg)

to:

Set xRg = Rows(1).FindNext(xRg)

What do you mean by:

export the data

 

[swartzfeger]

Try changing:

Set xRg = Range("A1:P1").FindNext(xRg)

to:

Set xRg = Rows(1).FindNext(xRg)

What do you mean by:

Sorry, by export I mean -- select all columns named "Missing #" and export them as a .csv

Also, do I change the row

Set xRg = Range("A1:P1").Find(xStr, , xlValues, xlWhole, , , True)

to

Set xRg = Rows(1).FindNext(xRg)

?

Thanks so much for your help!

 

[mumps]

Change the file name (in red) to suit your needs. The cvs file will be saved in the same folder as the workbook containing the macro.

Sub FindMissing()
    Application.ScreenUpdating = False
    Dim xRg As Range, xRgUni As Range, xFirstAddress As String, xStr As String
    xStr = "Missing #"
    Set xRg = Rows(1).Find(xStr, , xlValues, xlWhole, , , True)
    If Not xRg Is Nothing Then
        xFirstAddress = xRg.Address
        Do
            Set xRg = Range("A1:P1").FindNext(xRg)
            If xRgUni Is Nothing Then
                Set xRgUni = xRg
            Else
                Set xRgUni = Application.Union(xRgUni, xRg)
            End If
        Loop While (Not xRg Is Nothing) And (xRg.Address <> xFirstAddress)
    End If
    xRgUni.EntireColumn.Copy
    Workbooks.Add
    ActiveSheet.Paste
    fName = ActiveWorkbook.Path & "\FileNameHere" & ".csv"
    With ActiveWorkbook
        .SaveAs Filename:=fName, FileFormat:=xlCSV, CreateBackup:=False
        .Close False
    End With
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

 

[swartzfeger]

Change the file name (in red) to suit your needs. The cvs file will be saved in the same folder as the workbook containing the macro.

Sub FindMissing()
    Application.ScreenUpdating = False
    Dim xRg As Range, xRgUni As Range, xFirstAddress As String, xStr As String
    xStr = "Missing #"
    Set xRg = Rows(1).Find(xStr, , xlValues, xlWhole, , , True)
    If Not xRg Is Nothing Then
        xFirstAddress = xRg.Address
        Do
            Set xRg = Range("A1:P1").FindNext(xRg)
            If xRgUni Is Nothing Then
                Set xRgUni = xRg
            Else
                Set xRgUni = Application.Union(xRgUni, xRg)
            End If
        Loop While (Not xRg Is Nothing) And (xRg.Address <> xFirstAddress)
    End If
    xRgUni.EntireColumn.Copy
    Workbooks.Add
    ActiveSheet.Paste
    fName = ActiveWorkbook.Path & "\FileNameHere" & ".csv"
    With ActiveWorkbook
        .SaveAs Filename:=fName, FileFormat:=xlCSV, CreateBackup:=False
        .Close False
    End With
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

Mumps, this *almost* works. But I see the following error:

It successfully opens a second sheet with only the exported columns, but does not save it as a .csv due to this run-time error. I've checked Trust Center settings and can't seem to resolve this.

Thanks for your help so far!

 

[swartzfeger]

When I debug, it's highlighting the following line:

.SaveAs Filename:=fName, FileFormat:=xlCSV, CreateBackup:=False

 

[mumps]

Try:

Sub FindMissing()
    Application.ScreenUpdating = False
    Dim xRg As Range, xRgUni As Range, xFirstAddress As String, xStr As String, srcWB As Workbook
    Set srcWB = ThisWorkbook
    xStr = "Missing #"
    Set xRg = Rows(1).Find(xStr, , xlValues, xlWhole, , , True)
    If Not xRg Is Nothing Then
        xFirstAddress = xRg.Address
        Do
            Set xRg = Range("A1:P1").FindNext(xRg)
            If xRgUni Is Nothing Then
                Set xRgUni = xRg
            Else
                Set xRgUni = Application.Union(xRgUni, xRg)
            End If
        Loop While (Not xRg Is Nothing) And (xRg.Address <> xFirstAddress)
    End If
    xRgUni.EntireColumn.Copy
    Workbooks.Add
    ActiveSheet.Paste
    fName = srcWB.Path & "\FileNameHere" & ".csv"
    With ActiveWorkbook
        .SaveAs Filename:=fName, FileFormat:=xlCSV, CreateBackup:=False
        .Close False
    End With
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub