Excel 2003 - Select All Columns to the Right of a cell/range 2

[kjv1611]

I've found, again, the best code (I think) for finding the first blank cell in a range, or in other words, the next cell after all data in the range, but I also want to select that column, and all columns to the right, then delete the selected columns.

Can anyone offer any suggestions on the column selection part?

Here's what I have found for the whole deal:

----------------------------------------------------
To find the first blank/empty cell:

ws.Cells.Find(What:="", After:=[A1], SearchDirection:=xlNext).Select

From

http://www.ozgrid.com/VBA/ExcelRanges.htm

----------------------------------------------------
To select an entire column:

Sub TestMacro1()
    Range("B3").EntireColumn.Select
End Sub

From

http://excel.tips.net/Pages/T003093_Selecting_Columns_in_VBA_when_Cells_are_Merged.html

----------------------------------------------------

Now I just need to put it all together, select all columns to the right, and then delete the selected columns.

(Granted I could do it manually each time, but I'd rather get practice at the VBA part, and not have to remember it each time - once per month).

Thanks for any references, advice, etc.

--

"If to err is human, then I must be some kind of human!" -Me

 

[SkipVought]

Hi steve,

dim r as range

set r = [A1].end(xltoright).Offset(0,1) 'first empty cell

'now delete all cells to the right

range(r, [IV1]).entirecolumn.delete

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[kjv1611]

Thanks, Skip! That looks really nice - short and to the point. I'll give it a try, and post back.

I'm actually running it from within Access with an Excel object. I'll post back with any issues there, or at least post back with the whole deal..

--

"If to err is human, then I must be some kind of human!" -Me

 

[kjv1611]

Well, It's running with no errors now, but it didn't seem to delete the cells (I tried by adding random values into the cells below row 1 in a couple of columns, but they were still there.

Actually, I'm thinking that it may actually be deleting them, but that perhaps, I've got to save the changes? I'll look into that after I post this, and post back with those results...

Here is my entire code for now: (and I know it is picking up the correct workbook/worksheet, from tests run prior to this)
NOTE: Parts in [blue]blue[/blue] are those which I've added since posting here.

Public Sub RemoveXlBlankCol()
On Error GoTo ErrHandle
  Dim appXl As Object: Set appXl = CreateObject("Excel.Application")
  Dim wb as Excel.Workbook
  Dim ws as Excel.Worksheet
[blue]  Dim r as Excel.Rangge[/blue]
  Set wb = appXl.Workbooks.Open(Forms!frmImport!txtFile,,True,,,,True,,,False,False)
  wb.Activate
  Set ws = wb.Sheets("National")
  ws.Activate
[blue]  Set r = ws.Range("A1").End(xlToRight).Offset(0,1)
  ws.Range(r,"IV1").EntireColumn.Delete[/blue]

ExitSub:
On Error Resume Next
  appXl.DisplayAlerts = False
  wb.Close
  appXl.DisplayAlerts = True
  appXl.Quit
  Set appXl = Nothing
  Set wb = Nothing
  Set ws = Nothing
[blue]  Set r = Nothing[/blue]
  
  If appXl Is Nothing Then
  Else
    appXl.Quit
    Set appXl = Nothing
    If wb Is Nothing Then
    Else
      wb.Close
      set wb = Nothing
      If ws Is Nothing Then
      Else
        Set ws = Nothing
       [blue] If r Is Nothing Then
        Else
          Set r = Nothing
        End If[/blue]
      End If
    End If
  End If
  Exit Sub

ErrHandle:
  ErrTalk (Forms!frmImport!txtImportID)
  Resume ExitSub

End Sub

--

"If to err is human, then I must be some kind of human!" -Me

 

[kjv1611]

Well, I tried adding in [blue]wb.Save[/blue], but that apparently isn't the way to handle it here, I guess..

I'll do some more tinkering. Or if anyone has any suggestions to do differently, that'd be great as well..

--

"If to err is human, then I must be some kind of human!" -Me

 

[kjv1611]

Hmm, it appears to be something I'm doing in Access VBA with the Excel object that isn't quite right.

I tried this code in Excel to see:

Private Sub TestColumnDelete()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim r As Range
    
    Set wb = ActiveWorkbook
    Set ws = wb.ActiveSheet
    Debug.Print ws.Name
    Set r = ws.Range("A1").End(xlToRight).Offset(0, 1)
    ws.Range(r, "IV1").EntireColumn.Delete    
End Sub

It worked perfectly. So, off to see what the difference is with Access...

--

"If to err is human, then I must be some kind of human!" -Me

 

[PHV]

Set wb = [!]yourXLappObject.[/!]ActiveWorkbook

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[kjv1611]

Thanks, PHV, now I'm apparently saving it, b/c where I have this code:

    Set wb = appXl.ActiveWorkbook
    wb.Save

I get the prompt that says "....already exists, are you sure you want to replace it?" I say yes, but the supposedly deleted columns are still there...

I wonder why you have to re-Set the workbook to get it to save correctly..

Well, more digging to do for what I thought would have been a simple deal.

--

"If to err is human, then I must be some kind of human!" -Me

 

[kjv1611]

Here's another thought.

The prompt is asking me "are you sure you want to replace it?" So, if I save it that way, and just hit yes, then perhaps that's going to not allow it, since the workbook is currently "open"...

Maybe I need to do a "Save As", add a couple characters, and then rename after closing? Seems cumbersome, but I think I might try..

--

"If to err is human, then I must be some kind of human!" -Me

 

[kjv1611]

Finally have it all working, now. Thanks again for the code bits earlier to do the important tasks.

Here is an outline of what it does:
[OL][LI]Create Excel object and related.[/LI]
[LI]Find last cell in row 1[/LI]
[LI]Select all columns to the right of said cell[/LI]
[LI]Delete those columns[/LI]
[LI]Save workbook to a new file name[/LI]
[LI]Use Kill command to delete the original[/LI]
[LI]Save the workbook back to the original file name.[/LI]
[LI]Kill(delete) the new "temporary" workbook file[/LI]
[LI]Close everything out, aka clean up the memory.[/LI]
[/OL]

And here's my code:

Public Sub RemoveXlBlankCol()
[GREEN]'Instruct for errors during normal operation:[/GREEN]
On Error GoTo ErrHandle
[GREEN]'Set up variables and objects:[/GREEN]
  Dim appXl As Object: Set appXl = CreateObject("Excel.Application")
  Dim wb As Excel.Workbook
  Dim ws As Excel.Worksheet
  Dim r as Excel.Range
  Dim strOrigFileName As String
  Dim strFilePath() As String
  Dim strFileName() As String
  Dim strNewFilePath As String
  Dim x As Integer

[GREEN]'Open up the workbook, worksheet, range...[/GREEN]
  Set wb = appXl.Workbooks.Open(Forms!frmImport!txtXlFile,,True,,,,True,,,False)
  wb.Activate
  Set ws = wb.Sheets("National")
  ws.Activate

[GREEN]'Find the last cell in row 1 with data, select all columns to the right:[/GREEN]
  Set r = ws.Range("A1").End(xlToRight).Offset(0,1)
[GREEN]'Delete the selected columns:[/GREEN]
  ws.Range(r,"IV1").EntireColumn.Delete
[GREEN]'Refocus Excel on the current workbook, I guess..
  Set wb = appXl.ActiveWorkbook

[GREEN]'Parse out the Old File name and new temporary file name:[/GREEN]
  strFilePath = Split(strOrigFileName, "\")
  x = 0
  For x = 0 To UBound(strFilePath) - 1
    If x = 0 Then
      If strFilePath(x) = "" Then
        strNewFilePath = "\"
      Else
        strNewFilepath = strFilePath(x)
      End If
    Else
      If strFilePath(x) = "" Then
        strNewFilePath = "\"
      Else
        strNewFilePath = strNewFilePath & "\" & strFilePath(x)
      End If
    End If
  Next x
  strNewFielPath = strNewFilePath & "\"

[GREEN]'Save to temporary file name.[/GREEN]
  wb.SaveAs FileName:=strNewFilePath & strFileName(0) & "_2.xls"
[GREEN]'Get rid of original file.[/GREEN]
  Kill (strOrigFileName)
[GREEN]'Save to original file name.[/GREEN]
  wb.SaveAs strOrigFileName
[GREEN]'Get rid of the temporary file.
  Kill (strNewFilePath & strFileName(0) & "_2.xls"

[GREEN]'Standard Cleanup[/GREEN]
Exit Sub:
On Error Resume Next
  appXl.DisplayAlerts = False
  wb.Close
  appXl.DisplayAlerts = True
  appXl.Quit
  Set appXl = Nothing
  Set wb = Nothing
  Set ws = Nothing
  Set r = Nothing

  If appXl Is Nothing Then
  Else
    appXl.Quit
    Set appXl = Nothing
    If wb Is Nothing Then
    Else
      wb.Close
      Set wb = Nothing
      If ws Is Nothing Then
      Else
        Set ws = Nothing
        If r Is Nothing Then
        Else
          Set r = Nothing
        End If
      End If
    End If
  End If
  Exit Sub

[GREEN]'Standard Error Handling[/GREEN]
ErrHandle:
  ErrTalk (Forms!frmImport!txtImportID)
  Resume ExitSub

Exit Sub

So this is now working. However, if anyone has any suggestions as to how I could possibly do this more efficiently, please let me know!

--

"If to err is human, then I must be some kind of human!" -Me