Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
If Then in VBA, check cell, enter data to other cell
Hello all,
I am very new to Excel VBA stuff so I hope I explain this right. I have a sheet that data pulled into from another worksheet. The data is pulled via (=Sheet2!B19) being in the cell on sheet1. The number of rows below B19 can vary. After the data is worked, I want to be able to copy the results to a different workbook. I have the code working to copy the rows but the problem I have is that if I tell the code to select the last row with data in column B it does not stop at the last row of new data since the function in the cells creates a "0" (zero) in the cells. I would like to get the code to check column B from B19 down, When it finds a "0" (zero) think of that as the last row to copy. See below for the code I am using now. Sample of data... A1 .... B1..... C1 ... to V1 row19 Data data row20 data data row21 0 & 0n 0 I need to come up with a way to have VBA find the row that = 0 or the other way I thought of but can not code is to have VBA check for a zero in column B and if find one enter a X in the cell to the left (A21) nin above sample. my code as of now ... Sub copy_to_another_workbook() Dim sourceRange As Range Dim destrange As Range Dim destWB As Workbook Dim Lr As Long Application.ScreenUpdating = False If bIsBookOpen("test.xls") Then Set destWB = Workbooks("test.xls") Else Set destWB = Workbooks.Open("P:\COBdata\test.xls") End If Lr = LastRow(destWB.Worksheets("Sheet1")) + 1 'Set sourceRange = ThisWorkbook.Worksheets("COB_Cover_Sheet").Range(" A1:C10") With ThisWorkbook.Worksheets("Sheet1") Set sourceRange = .Range("B19:V" & .Range("A" & Rows.Count).End(xlUp).Row) End With Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr) sourceRange.Copy destrange.PasteSpecial xlPasteValues, , False, False Application.CutCopyMode = False destWB.Close True Application.ScreenUpdating = True End Sub --------------- Thanks a ton for any help in advance. Again I hope I explained this correct. Win |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
If Then in VBA, check cell, enter data to other cell
Sub copy_to_another_workbook()
Dim sourceRange As Range Dim destrange As Range Dim destWB As Workbook Dim Lr As Long Application.ScreenUpdating = False If bIsBookOpen("test.xls") Then Set destWB = Workbooks("test.xls") Else Set destWB = Workbooks.Open("P:\COBdata\test.xls") End If Lr = LastRow(destWB.Worksheets("Sheet1")) + 1 ' Set sourceRange = ThisWorkbook.Worksheets( _ ' "COB_Cover_Sheet").Range("A1:C10") With ThisWorkbook.Worksheets("Sheet1") Set sourceRange = .Range("B19:V" & _ .Range("A" & Rows.Count).End(xlUp).Row End With for each cell in sourceRange.columns(1).cells if cell.Value = 0 then set sourceRange = sourcerange.Resize(cell.row - 19) exit for end if Next Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr) sourceRange.Copy destrange.PasteSpecial xlPasteValues, , False, False Application.CutCopyMode = False destWB.Close True Application.ScreenUpdating = True End Sub -- Regards, Tom Ogilvy "Win" wrote in message ... Hello all, I am very new to Excel VBA stuff so I hope I explain this right. I have a sheet that data pulled into from another worksheet. The data is pulled via (=Sheet2!B19) being in the cell on sheet1. The number of rows below B19 can vary. After the data is worked, I want to be able to copy the results to a different workbook. I have the code working to copy the rows but the problem I have is that if I tell the code to select the last row with data in column B it does not stop at the last row of new data since the function in the cells creates a "0" (zero) in the cells. I would like to get the code to check column B from B19 down, When it finds a "0" (zero) think of that as the last row to copy. See below for the code I am using now. Sample of data... A1 .... B1..... C1 ... to V1 row19 Data data row20 data data row21 0 & 0n 0 I need to come up with a way to have VBA find the row that = 0 or the other way I thought of but can not code is to have VBA check for a zero in column B and if find one enter a X in the cell to the left (A21) nin above sample. my code as of now ... Sub copy_to_another_workbook() Dim sourceRange As Range Dim destrange As Range Dim destWB As Workbook Dim Lr As Long Application.ScreenUpdating = False If bIsBookOpen("test.xls") Then Set destWB = Workbooks("test.xls") Else Set destWB = Workbooks.Open("P:\COBdata\test.xls") End If Lr = LastRow(destWB.Worksheets("Sheet1")) + 1 'Set sourceRange = ThisWorkbook.Worksheets("COB_Cover_Sheet").Range(" A1:C10") With ThisWorkbook.Worksheets("Sheet1") Set sourceRange = .Range("B19:V" & .Range("A" & Rows.Count).End(xlUp).Row) End With Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr) sourceRange.Copy destrange.PasteSpecial xlPasteValues, , False, False Application.CutCopyMode = False destWB.Close True Application.ScreenUpdating = True End Sub --------------- Thanks a ton for any help in advance. Again I hope I explained this correct. Win |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
If Then in VBA, check cell, enter data to other cell
Tom,
Thank you for the reply, I tried the code and it stops at the line marked with **'s., Might you have any ideas Thank You Again Win for each cell in sourceRange.columns(1).cells if cell.Value = 0 then ***** set sourceRange = sourcerange.Resize(cell.row - 19) ****** exit for end if Next Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr) sourceRange.Copy destrange.PasteSpecial xlPasteValues, , False, False Application.CutCopyMode = False destWB.Close True Application.ScreenUpdating = True End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
If Then in VBA, check cell, enter data to other cell
It tested you code:
Sub copy_to_another_workbook() Dim sourceRange As Range Dim destrange As Range Dim destWB As Workbook Dim Lr As Long Application.ScreenUpdating = False ' If bIsBookOpen("test.xls") Then ' Set destWB = Workbooks("test.xls") ' Else ' Set destWB = Workbooks.Open("P:\COBdata\test.xls") ' End If ' Lr = LastRow(destWB.Worksheets("Sheet1")) + 1 ' Set sourceRange = ThisWorkbook.Worksheets( _ ' "COB_Cover_Sheet").Range("A1:C10") With ThisWorkbook.Worksheets("Sheet1") Set sourceRange = .Range("B19:V" & _ .Range("A" & Rows.Count).End(xlUp).Row) End With For Each cell In sourceRange.Columns(1).Cells If cell.Value = 0 Then Set sourceRange = sourceRange.Resize(cell.Row - 19) Exit For End If Next sourceRange.Select Exit Sub Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr) sourceRange.Copy destrange.PasteSpecial xlPasteValues, , False, False Application.CutCopyMode = False destWB.Close True Application.ScreenUpdating = True End Sub and it worked perfectly for me - especially for my contribution. If there is a problem, it is probably that you don't have data extending down in column A - but that was you code. -- Regards, Tom Ogilvy "Win" wrote in message ... Tom, Thank you for the reply, I tried the code and it stops at the line marked with **'s., Might you have any ideas Thank You Again Win for each cell in sourceRange.columns(1).cells if cell.Value = 0 then ***** set sourceRange = sourcerange.Resize(cell.row - 19) ****** exit for end if Next Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr) sourceRange.Copy destrange.PasteSpecial xlPasteValues, , False, False Application.CutCopyMode = False destWB.Close True Application.ScreenUpdating = True End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
If Then in VBA, check cell, enter data to other cell
"Tom Ogilvy" wrote: It tested you code: Sub copy_to_another_workbook() Dim sourceRange As Range Dim destrange As Range Dim destWB As Workbook Dim Lr As Long Application.ScreenUpdating = False ' If bIsBookOpen("test.xls") Then ' Set destWB = Workbooks("test.xls") ' Else ' Set destWB = Workbooks.Open("P:\COBdata\test.xls") ' End If ' Lr = LastRow(destWB.Worksheets("Sheet1")) + 1 ' Set sourceRange = ThisWorkbook.Worksheets( _ ' "COB_Cover_Sheet").Range("A1:C10") With ThisWorkbook.Worksheets("Sheet1") Set sourceRange = .Range("B19:V" & _ .Range("A" & Rows.Count).End(xlUp).Row) End With For Each cell In sourceRange.Columns(1).Cells If cell.Value = 0 Then Set sourceRange = sourceRange.Resize(cell.Row - 19) Exit For End If Next sourceRange.Select Exit Sub Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr) sourceRange.Copy destrange.PasteSpecial xlPasteValues, , False, False Application.CutCopyMode = False destWB.Close True Application.ScreenUpdating = True End Sub and it worked perfectly for me - especially for my contribution. If there is a problem, it is probably that you don't have data extending down in column A - but that was you code. -- Regards, Tom Ogilvy "Win" wrote in message ... Tom, Thank you for the reply, I tried the code and it stops at the line marked with **'s., Might you have any ideas Thank You Again Win for each cell in sourceRange.columns(1).cells if cell.Value = 0 then ***** set sourceRange = sourcerange.Resize(cell.row - 19) ****** exit for end if Next Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr) sourceRange.Copy destrange.PasteSpecial xlPasteValues, , False, False Application.CutCopyMode = False destWB.Close True Application.ScreenUpdating = True End Sub |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
If Then in VBA, check cell, enter data to other cell
Was there a message here?
-- Regards, Tom Ogilvy "Win" wrote in message ... "Tom Ogilvy" wrote: It tested you code: Sub copy_to_another_workbook() Dim sourceRange As Range Dim destrange As Range Dim destWB As Workbook Dim Lr As Long Application.ScreenUpdating = False ' If bIsBookOpen("test.xls") Then ' Set destWB = Workbooks("test.xls") ' Else ' Set destWB = Workbooks.Open("P:\COBdata\test.xls") ' End If ' Lr = LastRow(destWB.Worksheets("Sheet1")) + 1 ' Set sourceRange = ThisWorkbook.Worksheets( _ ' "COB_Cover_Sheet").Range("A1:C10") With ThisWorkbook.Worksheets("Sheet1") Set sourceRange = .Range("B19:V" & _ .Range("A" & Rows.Count).End(xlUp).Row) End With For Each cell In sourceRange.Columns(1).Cells If cell.Value = 0 Then Set sourceRange = sourceRange.Resize(cell.Row - 19) Exit For End If Next sourceRange.Select Exit Sub Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr) sourceRange.Copy destrange.PasteSpecial xlPasteValues, , False, False Application.CutCopyMode = False destWB.Close True Application.ScreenUpdating = True End Sub and it worked perfectly for me - especially for my contribution. If there is a problem, it is probably that you don't have data extending down in column A - but that was you code. -- Regards, Tom Ogilvy "Win" wrote in message ... Tom, Thank you for the reply, I tried the code and it stops at the line marked with **'s., Might you have any ideas Thank You Again Win for each cell in sourceRange.columns(1).cells if cell.Value = 0 then ***** set sourceRange = sourcerange.Resize(cell.row - 19) ****** exit for end if Next Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr) sourceRange.Copy destrange.PasteSpecial xlPasteValues, , False, False Application.CutCopyMode = False destWB.Close True Application.ScreenUpdating = True End Sub |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
If Then in VBA, check cell, enter data to other cell
Yes there should have been,
I am sorry Tom, you are correct... I did not have a zero in the row when I ran the code :( The code is working geat, I can not thank you enough. Sorry againn for the confusion Win "Tom Ogilvy" wrote: Was there a message here? -- |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Enter data and press enter to move to specific cell | Excel Programming | |||
Auto enter date when data in enter in another cell | Excel Worksheet Functions | |||
Force user to enter data in cell before moving to next cell | New Users to Excel | |||
enter data in cell but cannot save until click off cell in excel | Excel Discussion (Misc queries) | |||
how do I do a check on the data enter in the cell? | Excel Programming |