TheSwamp
Code Red => VB(A) => Topic started by: David Hall on November 14, 2006, 11:04:51 AM
-
I am trying to find the first empty cell in excell spreadsheet, and I cant seem to get past the with statement. Im not an excell programmer, so Im kinda lost. Here is the code I grabbed from the internet
Sub FindLastCell()
Dim LastCell As Range
With ActiveSheet
Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
If IsEmpty(LastCell) Then
'do nothing
Else
Set LastCell = LastCell.Offset(1, 0)
End If
End With
MsgBox LastCell.Row
End Sub
Any help or direction would be greatly appreciated :mrgreen:
-
this is what I came up with
Public Function GetLastRow() As Long
Dim wks As Excel.worksheet
Const BottomRowNum = 65536
Set wks = objExcel.ActiveSheet
Dim i As Long
For i = 1 To BottomRowNum
If IsEmpty(wks.Cells(i, 2)) Then
GetLastRow = i - 1
Exit Function
End If
Next
GetLastRow = BottomRowNum
End Function
-
Hi, Commandor
Not sure about how it will be work for you
At a first glance seems to be worked as I want
Option Explicit
'' ~~~~~~~~~~~~~~~~''
Function FindLastRow()
Dim LastRow As Range
With ActiveSheet
Set LastRow = .Cells.SpecialCells(xlCellTypeLastCell)
LastRow.Activate
End With
FindLastRow = LastRow.Row
End Function
'' ~~~~~~~~~~~~~~~~''
Function FindLastColumn() As Long
Dim LastColumn As Range
With ActiveSheet
Set LastColumn = .Cells.SpecialCells(xlCellTypeLastCell)
LastColumn.Activate
End With
FindLastColumn = LastColumn.Column
End Function
'' ~~~~~~~~~~~~~~~~''
Sub FindLastCell()
Dim LastCell As Range
With ActiveSheet
Set LastCell = .Cells(FindLastRow, FindLastColumn)
End With
LastCell.Activate
MsgBox "Last Cell Address: " & vbCr & LastCell.Address
End Sub
Tested on Excel2003 only
Hth
~'J'~
-
OK, any idea on how to format a cell from autocad?
-
OK, any idea on how to format a cell from autocad?
What do you want exactly,
format text in cell i.e. set bold, italic, color etc, or you need to format
value i.e. general, text, numberformat setting etc?
~'J'~
-
format value like text or number w/ 0 decimal places
-
CmdrDuh, sometimes it's easier to start a sub in excel just so you can see all the properties available then put it into the autocad vba. I only say this as Im not an excell programmer either.
-
format value like text or number w/ 0 decimal places
Here I added several properties for imagination
Hope this helps
Sub TestFormatACell()
Dim aCell As Range, bCell As Range
Set aCell = ActiveSheet.Range("A1")
Set bCell = Worksheets(3).Cells(1, 2)
aCell.Select
With ActiveCell
.Font.Bold = True
.Font.Italic = True
.Font.Color = RGB(255, 0, 0)
.NumberFormat = "0.0000000"
End With
bCell.Select
With ActiveCell
.VerticalAlignment = xlVAlignCenter
.HorizontalAlignment = xlLeft
.Font.Bold = False
.Font.Italic = False
.Font.Color = RGB(0, 255, 0)
.NumberFormat = "$#,##0.00"
End With
End Sub
~'J'~
-
cool, but how do you format it to be 'text' not a number?
-
cool, but how do you format it to be 'text' not a number?
You can use these formats:
.NumberFormat = "@" '' text format
or
.NumberFormat = "General" '' general format
~'J'~
-
CmdrDuh,
Another way to find out such trivial syntax thingies can be done this way:
1) Open a new workbook Excel
2) Select cell A1
3) Start the macro recorder to record a macro in thisWorkbook
4) in the format menu format -> cell format the cell for text
5) stop the macro recorder
6) Press Alt F11
7) Look at the code in module1
.numberformat = ........
will be the line you want.
-
Cool, I didn't know how to use the recorder
Fatty, thanks, I'll try that
-
Cool, I didn't know how to use the recorder
Fatty, thanks, I'll try that
Happy computing, Commandor
Cheers :)
>'J'<
-
It works perfectly. Next Step, automatic BOM
-
Very cool!
Too bad Autodesk hasn't consider real Utility design yet, you are way up on them. :-)
-
Sooooooooo close and yet it eludes me. I did as Dnereb suggested, and copied the macro from excel
Range("B2:B6").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
which had to be worked over to use my range
objExcelSheet.Range("b2", "b" & NextLine).Select
objExcel.Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
But it bombs on the sort. Any ideas?
-
early bound:
'To late bind alter all Excell.xxxxxx declarations into Object
Dim Wb As Excel.Workbook
Dim objExcelSheet As Excel.Worksheet
Dim Rng As Excel.Range
'assumming you've set the Excell.application somewher already
Set Wb = ExcellApp.ActiveWorkbook
Set objExcelSheet = Wb.Worksheets(1)
Set Rng = objExcelSheet.Range("b2:b6")
Rng.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
Set Rng = Nothing
Set objExcelSheet = Nothing
Set Wb = Nothing
-
ok, now im more confused than before
Here is what Im using
Option Explicit
Dim objSelSet As AcadSelectionSet
Dim objSelected As Object
Dim objExcel As Excel.Application
Dim objExcelSheet As Excel.Worksheet
Dim objExcelWb As Excel.Workbook
Dim objExcelRange As Range
'Dim objElem As Object
Dim varArray1 As Variant ' Array to store entity attributes
Dim intCount, intActR As Integer ' Counts the number of elements in the array
Dim blnFoundAttributes As Boolean 'Monitors whether entity has attributes
Dim blnRunning As Boolean ' Determines if Excel is running
Dim foundCell As Range ' Cell containing drawing #
Dim objBlkRef As AcadBlockReference
Dim objAttRef As AcadAttributeReference
Dim i As Integer, TotalBlocks As Integer, iCount As Integer, intType(0 To 1) As Integer
Dim varAtts As Variant, Atts As Variant, varData(0 To 1) As Variant
Dim objSelCol As AcadSelectionSets
Public strpms As String
Dim intQuantity As Integer
Dim strBlockName As String
Dim strStoresNumber As String
Const BottomRowNum = 65536
Private Sub PMS_Get_Number()
frmPMS.Show
End Sub
Public Function GetLastRow() As Long
Dim wks As Excel.Worksheet
Set wks = objExcel.ActiveSheet
Dim i As Long
For i = 1 To BottomRowNum
If IsEmpty(wks.Cells(i, 2)) Then
GetLastRow = i - 1
Exit Function
End If
Next
GetLastRow = BottomRowNum
End Function
Public Sub PMSLog()
On Error GoTo Err_Control:
PMS_Get_Number
strpms = "c:\PMS\" & strpms & ".xls"
Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
If objSelSet.Name = "PMS" Then
objSelSet.Delete
Exit For
End If
Next
Set objSelSet = objSelCol.Add("PMS")
intType(0) = 0: varData(0) = "INSERT"
intType(1) = 2: varData(1) = "*"
objSelSet.Select Mode:=acSelectionSetAll, filtertype:=intType, filterdata:=varData
blnRunning = IsAppRunning
If blnRunning Then
Set objExcel = GetObject(, "Excel.Application")
objExcel.UserControl = True
objExcel.Visible = True
Else
Set objExcel = CreateObject("Excel.Application")
objExcel.UserControl = True
objExcel.Visible = True
objExcel.Workbooks.Open strpms
End If
Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1")
objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)) = Null
objExcelSheet.Range("a2", objExcelSheet.Range("a2").End(xlDown)) = Null
objExcelSheet.Range("a2", objExcelSheet.Range("a2").End(xlDown)).NumberFormat = 0#
objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)).NumberFormat = "@"
'objExcelSheet.Range("a2", objExcelSheet.Range("a2").End(xlDown)) = 0
For Each objBlkRef In objSelSet
If objBlkRef.HasAttributes Then
varArray1 = objBlkRef.GetAttributes
For intCount = LBound(varArray1) To UBound(varArray1)
Select Case varArray1(intCount).TagString
Case "STORESNUMBER"
strStoresNumber = varArray1(intCount).TextString
Set foundCell = objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)).Find(strStoresNumber)
If foundCell Is Nothing Then
'add stores number to the list
Dim NextLine As Long
NextLine = GetLastRow() + 1
objExcelSheet.Cells(NextLine, 2).Value = strStoresNumber
Else
Set foundCell = Nothing
End If
End Select
Next intCount
End If
Next
'**********************************************************************
Set objExcelWb = objExcel.ActiveWorkbook
Set objExcelSheet = objExcelWb.Worksheets(1)
objExcelRange = objExcelSheet.Range("b2", "b" & NextLine).Select
objExcelRange.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
'************************************************************************
While NextLine > 1
objExcelSheet.Cells(NextLine, 1).Value = 0
NextLine = NextLine - 1
Wend
For Each objBlkRef In objSelSet
If objBlkRef.HasAttributes Then
varArray1 = objBlkRef.GetAttributes
For intCount = LBound(varArray1) To UBound(varArray1)
Select Case varArray1(intCount).TagString
Case "STORESNUMBER"
strStoresNumber = varArray1(intCount).TextString
Set foundCell = objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)).Find(strStoresNumber)
'Set foundCell = Columns("A").Find(strDwgNo)
If foundCell Is Nothing Then
MsgBox ("Did not find a stores number #")
Exit Sub
Else
foundCell.Activate
intActR = objExcel.ActiveCell.Row
Dim val As String
Set foundCell = Nothing
End If
End Select
Next intCount
objExcelSheet.Cells(intActR, 1).Value = CStr(objExcelSheet.Cells(intActR, 1).Value) + 1
End If
Next objBlkRef
If Not blnRunning Then
'We started the instance, so we can close it
objExcel.ActiveWorkbook.Save
objExcel.Quit
Else
objExcel.ActiveWorkbook.Save
End If
Exit_Here:
Set objExcel = Nothing
Set objExcelSheet = Nothing
Exit Sub
Err_Control:
objExcel.Quit
Set objExcel = Nothing
Set objExcelSheet = Nothing
MsgBox Err.Description, vbOKOnly, Err.Number
Resume Exit_Here
End Sub
'This determines how to set the Excel instance.
Private Function IsAppRunning() As Boolean
Dim objExcel As Excel.Application
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
IsAppRunning = (Err.Number = 0)
Set objExcel = Nothing
Err.Clear
End Function
-
CmdrDuh,
I've reworked your code "a bit" and added some comments. Two major issues caught my eye.
1) The recorder uses .Select to imitate exactly what is going on, but in code you do not need to select
you can manipulate any object directly if you've placed it in a variable
2) Avoid .active..... because during the run of your code the user can select another in one click of the mouse button (cell,worksheet or workbook alike)
Option Explicit
Dim objSelSet As AcadSelectionSet
Dim objSelected As Object
Dim objExcel As Excel.Application
Dim objExcelSheet As Excel.Worksheet
Dim objExcelWb As Excel.Workbook
Dim objExcelRange As Excel.Range
'Dim objElem As Object
Dim varArray1 As Variant ' Array to store entity attributes
Dim intCount, intActR As Integer ' Counts the number of elements in the array
Dim blnFoundAttributes As Boolean 'Monitors whether entity has attributes
'the boolean noe indicates if Excel was or was not running prior to this macro
Dim blnRunning As Boolean ' Determines if Excel is running
Dim BlnWorkbookPresent As Boolean 'Flags if the workbook was already open
Dim foundCell As Excel.Range ' Cell containing drawing #
Dim objBlkRef As AcadBlockReference
Dim objAttRef As AcadAttributeReference
Dim i As Integer, TotalBlocks As Integer, iCount As Integer, intType(0 To 1) As Integer
Dim varAtts As Variant, Atts As Variant, varData(0 To 1) As Variant
Dim objSelCol As AcadSelectionSets
Dim intQuantity As Integer
Dim strBlockName As String
Dim strStoresNumber As String
Const BottomRowNum = 65536 'eeuw! that is ugly the next Excel will have way more rows!
'you should adjust this
Const FILENAME_PMS = "C:\PMS\Test.xls"
'just for easy use
Const WORKBOOKNAME_PMS = "Test"
Private Sub PMS_Get_Number()
frmPMS.Show
End Sub
'Reworked that one to avoid the loop
Public Function GetLastRow() As Long
Dim Wks As Excel.Worksheet
Set Wks = objExcel.ActiveSheet 'this is a bit dangerous if Excel is visible because the user can activate another sheet
'usedrange defines the area that's been altered on a sheet
'of course the used range can start several rows below the first row.
GetLastRow = Wks.UsedRange.Row + Wks.UsedRange.Rows.Count
Set Wks = Nothing
End Function
Public Sub PMSLog()
On Error GoTo Err_Control:
PMS_Get_Number
Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
If objSelSet.Name = "PMS" Then
objSelSet.Delete
Exit For
End If
Next
Set objSelSet = objSelCol.Add("PMS")
intType(0) = 0: varData(0) = "INSERT"
intType(1) = 2: varData(1) = "*"
objSelSet.Select Mode:=acSelectionSetAll, filtertype:=intType, filterdata:=varData
'---------------------------------------------------------
'this is double up because you use getobject to determine
'if excel is running
'use the error to create an instance if it is not running
'blnRunning = IsAppRunning
'---------------------------------------------------------
'If blnRunning Then
' Set objExcel = GetObject(, "Excel.Application")
' objExcel.UserControl = True
' objExcel.Visible = True
'Else
' Set objExcel = CreateObject("Excel.Application")
' objExcel.UserControl = True
' objExcel.Visible = True
' objExcel.Workbooks.Open strpms
'End If
On Error GoTo NoExcel
blnRunning = True 'will be set to false if it wasn't in the error handler
Set objExcel = GetObject(, "Excel.Application")
objExcel.UserControl = True
objExcel.Visible = True
'search for the desired workbook if Excel was already open (you never know!)
If blnRunning Then
For Each objExcelWb In objExcel.Workbooks
If objExcelWb.Name = WORKBOOKNAME_PMS Then
BlnWorkbookPresent = True
Exit For
End If
Next
End If
If Not BlnWorkbookPresent Then Set objExcelWb = objExcel.Workbooks.Open(FILENAME_PMS)
'now you have controle over the workbook because you have an instance
'(objExcelWb) so you can adres it directly
'No use of active needed anymore
Set objExcelSheet = objExcelWb.Sheets("Sheet1")
'to late bind you need to use -4121 instead of xldown (the number it represents)
objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)) = Null
objExcelSheet.Range("a2", objExcelSheet.Range("a2").End(xlDown)) = Null
objExcelSheet.Range("a2", objExcelSheet.Range("a2").End(xlDown)).NumberFormat = 0#
objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)).NumberFormat = "@"
'objExcelSheet.Range("a2", objExcelSheet.Range("a2").End(xlDown)) = 0
For Each objBlkRef In objSelSet
If objBlkRef.HasAttributes Then
varArray1 = objBlkRef.GetAttributes
For intCount = LBound(varArray1) To UBound(varArray1)
Select Case varArray1(intCount).TagString
Case "STORESNUMBER"
strStoresNumber = varArray1(intCount).TextString
Set foundCell = objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)).Find(strStoresNumber)
If foundCell Is Nothing Then
'add stores number to the list
Dim NextLine As Long
NextLine = GetLastRow() + 1
objExcelSheet.Cells(NextLine, 2).Value = strStoresNumber
Else
Set foundCell = Nothing
End If
End Select
Next intCount
End If
Next
'**********************************************************************
'Already set the workbook
'Set objExcelWb = objExcel.ActiveWorkbook
Set objExcelSheet = objExcelWb.Worksheets(1)
'Select is used by the recorde to mimic exactly what you are doing, but in code you do not need to select stuff to alter it.
'Btw: Ranges are defined ("A1:C5") in my Excel not(A1,C5)
Set objExcelRange = objExcelSheet.Range("B2:B" & NextLine) '.Select
objExcelRange.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
'************************************************************************
While NextLine > 1
objExcelSheet.Cells(NextLine, 1).Value = 0
NextLine = NextLine - 1
Wend
For Each objBlkRef In objSelSet
If objBlkRef.HasAttributes Then
varArray1 = objBlkRef.GetAttributes
For intCount = LBound(varArray1) To UBound(varArray1)
Select Case varArray1(intCount).TagString
Case "STORESNUMBER"
strStoresNumber = varArray1(intCount).TextString
Set foundCell = objExcelSheet.Range("b2", objExcelSheet.Range("b2").End(xlDown)).Find(strStoresNumber)
'Set foundCell = Columns("A").Find(strDwgNo)
If foundCell Is Nothing Then
MsgBox ("Did not find a stores number #")
Exit Sub
Else
'no need to activate
'foundCell.Activate
'Use the object direcly like:
intActR = foundCell.Row
Dim val As String
Set foundCell = Nothing
End If
End Select
Next intCount
objExcelSheet.Cells(intActR, 1).Value = CStr(objExcelSheet.Cells(intActR, 1).Value) + 1
End If
Next objBlkRef
If Not blnRunning Then
'We started the instance, so we can close it
'Again use the object directly and avoid active, users have an annoying habbit of clicking
'while bored.
objExcelWb.Save
objExcel.Quit
Else
objExcelWb.Save
End If
Exit_Here:
' do it the other way around always set the dependent object to nothing first
'(in order of dependancy: Range,Worksheet,Workbook,Application)
'Set objExcel = Nothing
'Set objExcelSheet = Nothing
Set foundCell = Nothing
Set objExcelRange = Nothing
Set objExcelSheet = Nothing
Set objExcelWb = Nothing
Set objExcel = Nothing
Exit Sub
Err_Control:
objExcel.Quit
Set objExcel = Nothing
Set objExcelSheet = Nothing
MsgBox Err.Description, vbOKOnly, Err.Number
Resume Exit_Here
Exit Sub
NoExcel:
Set objExcel = CVreateObject("Excel.Application")
blnRunning = False 'the boolean noe indicates if Excel was or was not running prior to this macro
'continue on the next line for an instance of Excel is now present :)
Resume Next
End Sub
'This determines how to set the Excel instance.
Private Function IsAppRunning() As Boolean
Dim objExcel As Excel.Application
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
IsAppRunning = (Err.Number = 0)
Set objExcel = Nothing
Err.Clear
End Function
I can not test it (no acad at home for one, and living at GMT +1) so it bounds to have some bugs.
To late bind it replace all Excel.xxxxx to Object end replace Excel constants like XlDown with their corresponding number.
This way the code will run Excel version independent. Note: keep it early bound while developing, it will save you time.
-
Hi, Commandor
It's me again
At a first glance I don't see where you close a workbook
I use something like this:
objBook.Close SaveChanges:=True
objExcel.Quit
and then clean up all in reverse hyerarchcal order as
Dnereb said
Hth
~'J'~
-
are you meaning this?
If Not blnRunning Then
'We started the instance, so we can close it
objExcel.ActiveWorkbook.Save
objExcel.Quit
Else
objExcel.ActiveWorkbook.Save
End If
-
ok, I had to ask a guy here at work, and he came up with this
Private Sub sortexcel()
''To late bind alter all Excell.xxxxxx declarations into Object
Dim Wb As Excel.Workbook
Dim objExcelSheet As Excel.Worksheet
Dim Rng As Excel.Range
Dim Rng2 As Excel.Range
'assumming you've set the Excell.application somewher already
'Set Wb = ExcellApp.ActiveWorkbook
Set Wb = objExcel.ActiveWorkbook
Set objExcelSheet = Wb.Worksheets(1)
Set Rng = objExcelSheet.Range("B2:" & "B" & NextLine)
Set Rng2 = objExcelSheet.Range("B2")
Rng.Sort Rng2
Set Rng = Nothing
Set objExcelSheet = Nothing
Set Wb = Nothing
End Sub
He had to create rng2, I dont know why, but it works.
Next step is programming the formulas in to the cells for lookup tables
-
Is there anyway to have a macro in either excel or autocad that can look to see how many rows are used and insert based on that number?
-
To late bind it replace all Excel.xxxxx to Object end replace Excel constants like XlDown with their corresponding number.
This way the code will run Excel version independent. Note: keep it early bound while developing, it will save you time.
I hate to sound like a complete noob, but what exactly does that mean. I never understood early vs late binding
-
I can give you a bodgey version of early/late
Dim Excel As Object
'Excel As Excel.Application
Dim ExcelSheet As Object
'ExcelWorkbook As Workbook
Dim ExcelWorkbook As Object
'ExcelSheet As Worksheet
Dim r As Object
'R As Range
I'll often dim a sub like I've shown, dimming ExcelSheet As Worksheet gives me access to intellisense so it's easier to write the sub. When I'm finished I'll comment that out and dim it as an object (late bind it). The reason for this is late binding magically finds the current version of excel on the particular machine that is running your code and does it's stuff. Conversley early binding requires the reference that you set for excel (Vba->tools-> references ) on your machine to be the same on every machine that runs your code. If everyone doesn't have the same version the reference will throw a wobbler on the local machine. It's very difficult to code for so the late binding is the way to go.
-
Is there anyway to have a macro in either excel or autocad that can look to see how many rows are used and insert based on that number?
If you would store the number of rows in the usedrange.rows.count before the insert ans subtract it from usedrange.rows.count after the insert you will have the number of newly used rows in a sheet.
Early Binding/Late binding (addition to Bryco)
If you set a reference to Excel and use one of the objects in it's library, the layout of the excel object, it's propertie's methodes (in general how it looks) will be hardcoded in your code.
This saves time and intellisense can give a list of all legal possebility's to use of the object your working with.
This is called early binding because this binding the object shape to the code takes place at devolpinging time.
Late binding on the other hand avoids direct reference to the object (including predefined constants in it)
now intellisense can not give legitimate options because it's not "known" what the object will "look" like.
The actual structure will be defined at run time and accessed through COM. (this involves transfering data from two independent proccesses (marshalling) and takes a lot of time) In fact every time you use some part of the late bound object it needs to establish if this (Worksheet for instance) even is an existing property or method because the running code does not have a hard coded map of the excel object in this case.
I hope this will clarify the diffrence between the late and early binding a bit.
-
To late bind it replace all Excel.xxxxx to Object end replace Excel constants like XlDown with their corresponding number.
This way the code will run Excel version independent. Note: keep it early bound while developing, it will save you time.
I hate to sound like a complete noob, but what exactly does that mean. I never understood early vs late binding
This would be interesting for you I think :)
http://www.excelguru.ca/node/10
(about late binding with examples)
~'J'~