I have a program below which nearly works. One small problem. The program is designed to read through an excel spreadsheet and extract ONLY the sections where delivery date = "00/00/0000".
PROBLEM:- The program currently extracts the first record and the last record, it misses out the records in the middle.
eg. my excel spreadsheet has 4 records with a delivery date = 00/00/0000. The program extracts the first and last records where delivery date = 00/00/0000. Why does it miss the ones in the middle?
Any ideas?
VB Code:
Option Explicit
Dim objExcel As Object 'instead of Excel.Application
Dim oXLApp As Object 'instead of Excel.Spreadsheet
Dim NotShippedRow As Integer
Dim CurrentCell As Range
Private Sub Command1_Click()
objExcel.Worksheets("Sheet1").Select
objExcel.Range("H1").Select
Do Until objExcel.ActiveCell.Row = 800 'Can set this to any row number you like
If objExcel.ActiveCell.Value = "00/00/0000" Then 'each time a 00/00/0000 is found copy it
NotShippedRow = objExcel.ActiveCell.Row - 3
Call CopyCells
End If
objExcel.ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub CopyCells()
Dim MyRange As Object
Set MyRange = objExcel.Worksheets("Sheet1").Range(objExcel.Cells(NotShippedRow, 1), objExcel.Cells(NotShippedRow + 10, 9))
MyRange.Select
Selection.Copy
objExcel.Worksheets("Sheet2").Select
objExcel.Range("A1").Select
If objExcel.ActiveCell = "" Then
objExcel.ActiveSheet.Paste
objExcel.Worksheets("Sheet1").Select
objExcel.Cells(NotShippedRow + 4, 8).Select
Else
objExcel.ActiveCell.Offset(13, 0).Select 'If one 00/00/0000 has been pasted move down 13 lines and paste the next
objExcel.ActiveSheet.Paste
objExcel.Worksheets("Sheet1").Select
objExcel.Cells(NotShippedRow + 4, 8).Select
End If
'objExcel.Quit
'Set objExcel = Nothing
End Sub
Private Sub Form_Load()
Set objExcel = CreateObject("Excel.Application")
Set oXLApp = objExcel.Workbooks.Open(FileName:=App.Path & "\" & "New.xls")
I think the problem is in your CopyCells routine. When you enter the routine, you set the activecell to A1, then say, "is this cell empty; yes or no". If it is empty (i.e. the first record) update A1 with whatever details. Then, the second occurence does the same, and says "Is A1 empty; yes or no?" this time it is not empty and therefore jumps down 13 cells, and updates itself again. Then, keep looping, and performing the same, then the last record overwrites the cell A14 (A1 + 13 becuase A1 is not empty). So you see it never goes past the A14. The way to do this would be to set a global variable and hold onto that variable, then use the following code to identify if the cell is empty or not:
Code:
if Sheets("Sheet2").Cells(variable, 1) = "" then
Sheets("Sheet2").Cells(variable, 1) = WHATEVER
else
Sheets("Sheet2").Cells(variable, 1) = WHATEVER
variable = variable + 13
end if
And when you first start the code (the button click) set "variable" equal to 1. And what you should find is that each time you call the code, it will check the last cell that it updated.
One other trick... if you use the Cells call and the Sheets("").Cells() call it operates much quicker than saying "ActiveCell.Offset". As an example I have rewritten your button_click
Code:
Private Sub Command1_Click()
objExcel.Worksheets("Sheet1").Select
objExcel.Range("H1").Select
For x = 1 to 800
If Cells(x,1) = "00/00/0000" Then
NotShippedRow = x
Call CopyCells
End If
Next x
End Sub
thanks - you say i need to " set a global variable and hold onto that variable" - im not sure of the syntax or how to do that. Can you help edit what i have?
Ive done what you said on the command click - only need help writing the rest.
OK so going back to your code sample, the first line is "option explicit". Underneath this command is a list of variable declarations (Dim xxxxx, etc...). These are variables that are available throughout the entire section of code. So, add another one under this like:
Dim variable as integer
If you would like to post the XL spreadsheet I will do it and send it back to you?
To get this running, there should be a macro in the list if you go to "Tools"..."Macro"..."Macros"... then there should be an item called "ThisWorkbook.RunMe". The source code is in there - just highlight the macro and hit run. It should print a Msgbox at the end of the routine saying "Done". If you do not get this, then the macro is not being started. Try opening the code editor, click inside the subroutine called "RunMe" and press F5.
Regarding your other query, I thought you were only running this inside Excel. There is only a small change required to place this code in a VBScript file. You need to add a reference to an excel.application object.
why is that when i run the macro within test.xls it works .i.e it copies selected cells to sheet2.
However when i copy the visual basic code from the macro & place it in a brand new spreadsheet called new.xls & run the macro - nothing happens. "done" is displayed but no records are copied across to sheet 2.
Why would you ever make a copy of the macro? Why not just have a master file with the macro, and then whenever you need a file just copy the master file and name it to what you want. Then run the macro. It is much easier that way I think. All your formats are still there and the worksheets you want.
Motto: Anything for a laugh.
Getting second place only means you are the first loser to cross the finish line.
Ok give me some time to test this out and figure out why it won't work when you copy macros around. I know I had a similiar problem and I just solved it by doing what I said earlier, but I guess that isn't an option for you hehe.
Motto: Anything for a laugh.
Getting second place only means you are the first loser to cross the finish line.
Ok when I tried running the text.xls macro it worked fine for me. Then I copied and pasted it to a new workbook that I just created. Then I copied the data from sheet 1 in text.xls so I would have some test data. Then I ran the macro in new.xls and it worked fine for me. I am guessing it won't work for you because the new.xls you are doing either is not matching the format for sheet1 that the macro needs or you don't have any data in sheet1 of new.xls for it to copy. Please post the new.xls that you made where the macro doesn't run and I will take a look at it.
Motto: Anything for a laugh.
Getting second place only means you are the first loser to cross the finish line.
Nearly there - excel query
Reply With Quote
