1

I know just enough about this to get it wrong.

I am wanting to delete all the columns in a file except the ones in my defined list. The sub below does the opposite. while workable, I'd rather not define what I want to delete as i have no control over what column names are added in the source file and I will keep having to update the list. I need to keep ~90 columns, so I dont want to define them as a sting within the sub

PACEKEEP is the list of column name i want to keep contour-export is the source file.

Also, i'd like to keep the list PACEKEEP in a file sperate from the working file (call PACEKEEP from a static file). currently i am adding PACEKEEP as a sheet on contour-export

Sub PACEKILL()
  Dim f As Range, c As Range
  For Each c In Sheets("PACEKEEP").Range("A2", Sheets("PACEKEEP").Range("A" & Rows.Count).End(xlUp))
    Set f = Sheets("contour-export").Rows(1).Find(c.Value, , xlValues, xlWhole)
    If Not f Is Nothing Then f.EntireColumn.Delete
  Next
End Sub

The sub will delete the column headers in the file, I want to delete the columns not in the file

BigBen
  • 46,229
  • 7
  • 24
  • 40
ThePicMan
  • 11
  • 1
  • 1
    Flip the logic: loop through the first row and look up the values against the PACEKEEP list. – BigBen Mar 06 '23 at 21:20

2 Answers2

0

You ask several questions, but here's how to open another file:

Sub OpenAnotherFile()
Dim wbM As Workbook
Dim sUrl As String, b As Boolean
Dim app As New Excel.Application
app.Visible = False
sUrl = "C:\Temp\myFile.xlsx"
sName = Mid(sDir, InStrRev(sUrl, "\") + 1)
b = isFileOpen(sName)
If b Then
    Set wbM = Application.Workbooks.Item(sName)
    If wbM.readOnly Then
        MsgBox "File is read only", vbExclamation, "Read only"
        Exit Sub
    End If
Else
    Set wbM = app.Workbooks.Add(sUrl)
End If

'Do stuff

wbM.SaveAs Filename:=sUrl
wbM.Close
app.Quit
Set app = Nothing
End Sub

Function isFileOpen(sName As String) As Boolean
Dim wb As Workbook
isMasterOpen = False
For Each wb In Workbooks
    If wb.Name = sName Then
        isMasterOpen = True
        Exit For
    End If
Next wb
End Function

How to look for empty rows, look here: How to find out if an entire row is blank in excel thorough vba

Loveb
  • 278
  • 1
  • 9
  • Thanks for the script, I will see how it works on my side as soon as i have access back to the dbs needed. Someone did an access purge last night and I am DOA for a few days – ThePicMan Mar 07 '23 at 22:27
0

Delete Bad Columns

Sub PACEKILL()
  
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Sheets("PACEKEEP")
    Dim srg As Range:
    Set srg = sws.Range("A2", sws.Cells(sws.Rows.Count, "A").End(xlUp))
    
    Dim dws As Worksheet: Set dws = wb.Sheets("Contour-Export")
    Dim drg As Range:
    Set drg = dws.Range("A1", dws.Cells(1, dws.Columns.Count).End(xlToLeft))
    
    Dim scIndexes(): scIndexes = Application.Match(drg, srg, 0)
    
    Dim drgDel As Range, c As Long, IsBadColumnFound As Boolean
    
    For c = 1 To UBound(scIndexes)
        If IsError(scIndexes(c)) Then
            If IsBadColumnFound Then
                Set drgDel = Union(drgDel, drg.Cells(c))
            Else
                Set drgDel = drg.Cells(c)
                IsBadColumnFound = True
            End If
        End If
    Next c
    
    If IsBadColumnFound Then
        drgDel.EntireColumn.Delete
        MsgBox "Bad columns deleted.", vbInformation
    Else
        MsgBox "No bad columns found.", vbExclamation
    End If
 
End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28
  • thanks for the script, I will try to implement this soon to see how it runs on my side. Someone thought it would be a good idea to kill my access to the db in question last night, so i wont be able to validate for a few days. – ThePicMan Mar 07 '23 at 22:23