Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations John Tel on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel... Missing Something fundamental about ranges

Status
Not open for further replies.

lameid

Programmer
Jan 31, 2001
4,212
US
I am trying to get a 'macro' to start with Cell D1 and if it contains data, insert a column next to it and set its formula to the afore mentioned cell and concatenate " Update" to it.

My problem seems to be with the line of code
lngColumn = ActiveCell.Column

Below is my procedure. I understand that it doesn't work because it is returning the column of the active range instead of the column's postion on the entire sheet. I just don't know the Excel object model well enough to fix it.

Your help is most appreciated.


Sub Example
Dim lngColumn As Long
Application.WindowState = xlMinimized

ActiveSheet.Range("D1").Select
While IsNull(ActiveCell.Formula) = False
lngColumn = ActiveCell.Column
ActiveSheet.Columns(lngColumn + 1).Select
Selection.Insert Shift:=xlToRight
ActiveSheet.Range(lngColumn + 1 & ":1").Select
ActiveCell.FormulaR1C1 = "=RC[-1] & "" Update"""
ActiveSheet.Columns(ActiveCell.Column).EntireColumn.AutoFit
ActiveSheet.Columns(ActiveCell.Column).Select
Selection.Locked = False
Selection.FormulaHidden = False
ActiveSheet.Range(lngColumn + 2 & ":1").Select
Wend
Cells.Select
Cells.EntireColumn.AutoFit
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub
 
ActiveCell.Column returns a number not a letter.
Try ActiveCell.Offset(0, 1).Select to move over one column.
djj
 
That helps thanks. Counterintuitive to me considering I also select a column between use but it works.

I did see something else that is weird in my final product.
I am dumping margin for various products from a crosstab query in access and adding a column for the sales people to optionally update the product (Sales people sell different products), column D is the first product column of the output.

My issue is that Excel.exe is still running (in process list under Windows XP).

I both quit and set the application object to nothing.


My procedure...


Private Sub cmdAffMarginUpdate_Click()
On Error GoTo Err_cmdAffMarginUpdate_Click
Dim XLApp As Excel.Application
Dim stDocName As String
Dim strFile As String

stDocName = "qry Margin By Affiliate"
strFile = "c:\sec\" & stDocName & ".xls"
Kill strFile
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, stDocName, strFile, True

Set XLApp = CreateObject("Excel.Application")
With XLApp
.Workbooks.Open FileName:=strFile
.ActiveSheet.Range("D1").Select
While (.ActiveCell.Formula) <> ""
.ActiveCell.Offset(0, 1).Select
.ActiveSheet.Columns(ActiveCell.Column).EntireColumn.Insert Shift:=xlToRight
.ActiveCell.FormulaR1C1 = "=RC[-1] & "" Update"""
.ActiveSheet.Columns(ActiveCell.Column).Select
.Selection.Locked = False
.Selection.FormulaHidden = False
.ActiveCell.Offset(0, 1).Select
Wend
.Cells.Select
.Cells.EntireColumn.AutoFit
.ActiveSheet.Protect Password:="wonkachocolate", DrawingObjects:=True, Contents:=True, Scenarios:=True
.Range("D2").Select
.ActiveWindow.FreezePanes = True
.ActiveWorkbook.Close True
If .Workbooks.Count = 0 Then
.Quit
End If
End With
Set XLApp = Nothing
Exit_cmdAffMarginUpdate_Click:
Exit Sub

Err_cmdAffMarginUpdate_Click:
If Err.Number = 53 Then
Resume Next
Else
MsgBox Err.Number & ": " & Err.Description
Resume Exit_cmdAffMarginUpdate_Click

End If
End Sub


 
...
.ActiveSheet.Columns([highlight].[/highlight]ActiveCell.Column).EntireColumn.Insert Shift:=xlToRight
.ActiveCell.FormulaR1C1 = "=RC[-1] & "" Update"""
.ActiveSheet.Columns([highlight].[/highlight]ActiveCell.Column).Select
...

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
Thanks PHV. I can't believe I overlooked that or more signicicantly that it did not error.

Thanks Again.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top