Excel VBA

Guys,

Please help me in developing a small piece of code, Basically i have an excel which i need to run every week. So every time the new data should be updated in a new line but it should not erase the existing one.

So i need a code to find the end of a row in an excel and start executing set of conditions from the next row.


Please find the code below:-

Code:

---

objExcel.Visible = True
    Myfile = "D:\Chart\DQ_03-23"
    Set objWB = objExcel.Workbooks.Open(Myfile)
   
    Set objWS = objWB.Worksheets.Add
    objWS.Name = "Chart"
   
    objWS.Cells(2, 1) = DatePart("yyyy", Now)
    objWS.Cells(2, 2) = DatePart("ww", Now)
    ActiveCell.FormulaR1C1 = "=RC[-2]&""_""&""FW""&RC[-1]"
    objWS.Cells(2, 3) = ActiveCell.FormulaR1C1

---

Excel o/p is below:

YEAR FW Yr_FW
2009 30 2009_FW30
*** ** ******

So, next time when i run it should search end of a row and execute the same 3 conditions.
Would you be able to help me in getting this code.

Thanks in advance

I did this once a long time ago and ran into several problems. First, Excel does not do well in just checking the value of a cell compared to "". I think you need to do something like

Code:

---

If len(trim(objWS.Cells(2,y))) = 0 then
  ...
end if

---

But you may need to play around with different formulas until you find one that actually determines when a cell is blank.

You should create a routine that goes from 1 - the max cell range and checks each cell to see if it is blank to find the last column or row that has a value in it.

Thread moved to Office Development/VBA forum (note that the "VB Editor" in Office programs is actually VBA rather than VB, so the VB6 forum is not really apt)

you can use the SpecialCells funciton passing the Last used cell constant (xlCellTypeLastCell) or pass xlCellTypeBlanks if you only want to look for a blank cell

Code:

---

Dim oRange As Range
Set oRange = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)
MsgBox oRange.Address

---

Thanks Rob it work!!!
There is one more query, as i am not expertise in writing a code but would you please help me out.
when it finds the end of cell through the below code

Dim oRange As Range
Set oRange = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)
MsgBox oRange.Address

I would like to know how will i execute the below 3 conditions but from the next cell, as in the code itself i specified objWS.Cells(2, 1) which is cell specific, so the o/p will be recorded in the same cell rather "i require everytime in a new cell"


objWS.Cells(2, 1) = DatePart("yyyy", Now)
objWS.Cells(2, 2) = DatePart("ww", Now)
ActiveCell.FormulaR1C1 = "=RC[-2]&""_""&""FW""&RC[-1]"
objWS.Cells(2, 3) = ActiveCell.FormulaR1C1

Thanks in Advance...

Would anybody help me in this regards...Please [:(]

Please do not bump your threads. For some of the reasons, see this. People will read your thread (and hopefully reply) when they get the time to do so.

Quote:

---

Originally Posted by RobDog888

you can use the SpecialCells funciton passing the Last used cell constant (xlCellTypeLastCell) or pass xlCellTypeBlanks if you only want to look for a blank cell

Code:

---

Dim oRange As Range
Set oRange = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)
MsgBox oRange.Address

---

---

While these DO work most of the time, some of the special cell do not "update" when you make changes to a worksheet - only when you save the worksheet. So, if you have say, 100 rows of data and you clear the bottom 50 but don't save, the xlCellTypeLastCell will still return a range on row 100. It's not really a problem if you're aware of it and it's for personal use though - just save the worksheet after major changes.

I've been using a variation of the following to get the last used row on a sheet (edit: I am not sure how it behaves with non-contiguous ranges! My assumption was it drew a box with the min/max row/columns, but this may be a false assumption.):

Code:

---

'---Returns a range containing the next free row, under the last used row in the given sheet

Private Function FirstEmptyRow(sheet As Worksheet) As Range
    On Error GoTo errorhandler:
    Dim row As Long 'An integer will overflow before we run out of rows.
    Dim column As String

    row = sheet.UsedRange.Rows.count + 1
    column = "A"
    Set FirstEmptyRow = Range(column & row)
    Exit Function
       
errorhandler:
    '---runtime error 1004 seems to be used for general method failures. To be sure
    '---we're catching the right error, we check to see if it mentions the method "Range"
   
    If Err = 1004 And InStr(Error(Err), "Range") > 0 Then
        MsgBox "No more empty rows below existing data."
        Set selectInEmptyRow = Nothing

    Else
        MsgBox "Error " & Err & ": " & Error(Err)
        Set selectInEmptyRow = Nothing

    End If

---

Realistically it shouldn't ever need the error handler, but I included it anyway just in case. Since it's not likely to happen, it's a fairly shoddy and uninformative one though.

edit:
You could even just return a Long containing the row number of the last used row. I just copy and pasted the code I had been using, but you may want to modify it to suit your needs more.

One warning though - I didn't know this before, but apparently using usedrange.rows.count will delete your "Undo" stack, meaning that Excel will forget what actions you've done recently and you won't be able to select "Undo" from the edit menu or use Ctrl-Z to undo recent changes.

where do i incorporate these 3 conditions:

objWS.Cells(2, 1) = DatePart("yyyy", Now)
objWS.Cells(2, 2) = DatePart("ww", Now)
ActiveCell.FormulaR1C1 = "=RC[-2]&""_""&""FW""&RC[-1]"
objWS.Cells(2, 3) = ActiveCell.FormulaR1C1

Explicitly no need to give the row & column numbers..as i have given in the conditions above..

the safest way i know to get the last row is
range("c65536").End(xlUp).Row
note this is column specific, if column A has data in a couple more rows will not be shown,
a problem with usedrange is it does not count empty rows at the top of a sheet, so you would have to add that value to the rows count to be safe
sheets("sheet1").usedrange.rows.count + sheets("sheet1").usedrange.row
also as si pointed out above the used range can include rows that have been deleted, until saving, sometimes even after

if i understand correctly you want to do like

vb Code:

r = range("a65536").End(xlUp).Row +1  ' next empty row
objWS.Cells(r, 1) = DatePart("yyyy", Now)
objWS.Cells(r, 2) = DatePart("ww", Now)
ActiveCell.FormulaR1C1 = "=RC[-2]&""_""&""FW""&RC[-1]"
objWS.Cells(r, 3) = ActiveCell.FormulaR1C1

hi,

thanks for the response.

Exactly i wanted to do the same way, i will try to execute the above code and will let you know it wokred or not :)

Would you please explain what does the below piece of code does?

range("c65536").End(xlUp).Row
It goes to end of a row or it select the last used row and start filling from next row?

Thanks

Quote:

---

range("c65536").End(xlUp).Row

---

last used row
+ 1 for first empty

Hey,

I tried to run your code, but unfortunatley it is throwing some error.
Method 'Cells' of object '_Worksheet' failed

Would you please help!!!

Thanks...

on rereading the entire thread i find that objws is a workbook object, where you need to be working with a worksheet object

vb Code:

set omysht = objws.sheets("sheet1")
      r = omysht.range("a65536").End(xlUp).Row +1  ' next empty row
      omysht.Cells(r, 1) = DatePart("yyyy", Now)
      omysht.Cells(r, 2) = DatePart("ww", Now)
      objexcel.ActiveCell.FormulaR1C1 = "=RC[-2]&""_""&""FW""&RC[-1]"
      omysht.Cells(r, 3) = ActiveCell.FormulaR1C1

it didnt worked... :(
any other solution, basically why this error comes up?

Quote:

---

it didnt worked...

---

The above statement will not be of much help as it doesn't tell me why it didn't work... :)

Two questions...

1) Are you working with Excel 2003 or Excel 2007?
2) Can I see your declarations on how are you connecting with excel?

which lines highlighted when error?
or no error incorrect result?

Pls find the code below:

Quote:

---

Private Sub Form_Load()
GenerateBentlyChart
End Sub
Function GenerateBentlyChart()

Set BentlyRS = New ADODB.Recordset
Set BentlyCON = New ADODB.Connection
' transQuery = ""
' Set appExcel = New Excel.Application
objExcel.Visible = True
Set objWB = objExcel.Workbooks.Add
Set objWS = objWB.Worksheets(1)

objWS.SaveAs App.Path & "\Bently\" & Date$ & "_Bently.xls"

objWS.Cells(2, 1) = "YEAR"
objWS.Cells(2, 2) = "FW"
objWS.Cells(2, 3) = "Yr_FW"
objWS.Cells(2, 4) = "3300 RACK"
objWS.Cells(2, 5) = "3500 RACK"
objWS.Cells(2, 6) = "MkVI"
objWS.Cells(2, 7) = "F-FLEET"
objWS.Cells(2, 8) = "CA Implement"
objWS.Cells(2, 9) = "LSL for CA"
objWS.Cells(2, 11) = "3300 RACK"
objWS.Cells(2, 12) = "3500 RACK"
objWS.Cells(2, 13) = "MkVI"
objWS.Cells(2, 14) = "F-FLEET"
objWS.Cells(2, 16) = "3300 RACK"
objWS.Cells(2, 17) = "3500 RACK"
objWS.Cells(2, 18) = "MkVI"
objWS.Cells(2, 19) = "F-FLEET"
objWS.Cells(2, 21) = "Bently>50"
objWS.Cells(2, 22) = "DWATT>50"
objWS.Cells(2, 23) = "# of units w/ CA"

objExcel.Workbooks.Close

'** Open the Excel File
objExcel.Workbooks.Open App.Path & "\Bently\" & Date$ & "_Bently.xls"
objExcel.Visible = True

r = Range("a65536").End(xlUp).Row + 1 ' next empty row
objWS.Cells(r, 1) = DatePart("yyyy", Now)
objWS.Cells(r, 2) = DatePart("ww", Now)
ActiveCell.FormulaR1C1 = "=RC[-2]&""_""&""FW""&RC[-1]"
objWS.Cells(r, 3) = ActiveCell.FormulaR1C1

End Function

---

The one which i highlighted is throwing an error.

Please suggest :)

Thnaks

Any Help would be appreciated...:)

The cause of the error is actually different lines (presumably including the one just before it), because you have not qualified the Excel objects with their parent objects, it should be like this:

Code:

---

r = objWS.Range("a65536").End(xlUp).Row + 1 ' next empty row
objWS.Cells(r, 1) = DatePart("yyyy", Now)
objWS.Cells(r, 2) = DatePart("ww", Now)
objWS.ActiveCell.FormulaR1C1 = "=RC[-2]&""_""&""FW""&RC[-1]"
objWS.Cells(r, 3) = objWS.ActiveCell.FormulaR1C1

---

...in fact, you haven't even got the parent objects (objWS and objWB) set up properly, because you didn't reset them when opening a new file. You already have what you need in your code, so I'll let you work out the details.


In addition to that, instead of this line (which might close the wrong file):

Code:

---

objExcel.Workbooks.Close

---

..you should have something like this:

Code:

---

objWB.Close

---

Its still not working, as per above code now it is thowing error at the very first step

vb Code:

r = objWS.Range("a65536").End(xlUp).Row + 1 ' next empty row

When an error occurs, tell us which error it is - that not only makes things easier for us, but also can make a very big difference to what the solution is.

I assume you haven't done this yet:

Quote:

---

Originally Posted by si_the_geek

...in fact, you haven't even got the parent objects (objWS and objWB) set up properly, because you didn't reset them when opening a new file. You already have what you need in your code, so I'll let you work out the details.

---

I tried it but was not successfull...
This is the code...

vb Code:

r = Range("a65536").End(xlUp).Row + 1 ' next empty row
    objWS.Cells(r, 1) = DatePart("yyyy", Now)
    objWS.Cells(r, 2) = DatePart("ww", Now)
    ActiveCell.FormulaR1C1 = "=RC[-2]&""_""&""FW""&RC[-1]"
    objWS.Cells(r, 3) = ActiveCell.FormulaR1C1
    
    Myfile = "C:\Documents and Settings\sw47604\Desktop\dq\FW-22\Block10n11.xls"
    Set objWB = objExcel.Workbooks.Open(Myfile)
    
    Selection.AutoFilter Field:=13, Criteria1:="=*3300*", Operator:=xlAnd
    Selection.AutoFilter Field:=12, Criteria1:=">50", Operator:=xlAnd
    objWS.Cells(r, 11) = WorksheetFunction.Subtotal(3, Range("A2:A700"))
    
    Selection.AutoFilter Field:=13, Criteria1:="=*3500*", Operator:=xlAnd
    Selection.AutoFilter Field:=12, Criteria1:=">50", Operator:=xlAnd
    objWS.Cells(r, 12) = WorksheetFunction.Subtotal(3, Range("A2:A700"))
    
    Selection.AutoFilter Field:=13, Criteria1:="MKVI"
    Selection.AutoFilter Field:=12, Criteria1:=">50", Operator:=xlAnd
    objWS.Cells(r, 13) = WorksheetFunction.Subtotal(3, Range("A2:A700"))
    
    Selection.AutoFilter Field:=13, Criteria1:="="
    Selection.AutoFilter Field:=12, Criteria1:=">50", Operator:=xlAnd
    objWS.Cells(r, 14) = WorksheetFunction.Subtotal(3, Range("A2:A700"))

Uptill 14th row it has to fill and again the same loop has to start from empty row next time..
but still throwing rthe same error as i mentione earlier..
Please comment,....

without seeing your entire code, it is hard to say the specific problem, but as you still have not taken the advice from si about correctly setting your objects it is unlikely anyone can help you