Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Next Cell Empty Issues
Here is the code I have now, and what I need it to do.
Sub Data_Extract() Dim WS1 As Worksheet Dim WS2 As Worksheet Dim WS3 As Worksheet Dim WS4 As Worksheet Dim rng1 As Range Dim rng2 As Range Dim Str As String Set WS1 = Sheets("Summary") Set WS2 = Sheets("Credits") Set WS3 = Sheets("Payroll") Set WS4 = Sheets("Macros") WS3.Select Range("A5:AA1500").Select Selection.Copy WS4.Select Range("A1").Select ActiveSheet.Paste Do Until IsEmpty(ActiveCell) Set rng1 = WS4.Range("A2:AA1497").CurrentRegion Str = WS4.Range("C2").Value WS4.Select WS4.AutoFilterMode = Flase rng1.AutoFilter Field:=3, Criteria:=Str WIth WS4.AutoFilter.Range On Error Resume Next Set rng2 = .Offset(1,0).Resize(.Rows.Count - 1, .Columns.Count) ..SpecialCells (xlCellTypeVariable) 'HERE IS WHERE I NEED HELP!!!!! WS2.Select Range("K5").Select 'Data Field to Copy Selection.Copy WS1.Select Range("A8").Select 'First Cell on sheet where data needs to go ' I need this to look for the next blank cell on the page and then paste the value of ' The Data Field to Copy there. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Then on the same Row I need it to do the following.... 'If value of cell AV9=AX3 on WS2 it needs to copy value from WS2 cell AV70 to 'the same row in colum B. 'END HELP NEEDED SECTION !!!! WS2.Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True WS2.Select Range("A10:AA69").ClearContents If Not rng2 Is Nothing Then rng2.Copy WS2.Range("A1" & LastRow(WS2) + 0) rng2.EntireRow.Delete End If End With WS4.AutoFilterMode = False WS4.Select Range("C2").Activate Loop End Sub Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", After:=sh.Range("A6:AA1497"), LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row On Error GoTo 0 End Function |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Next Cell Empty Issues
'HERE IS WHERE I NEED HELP!!!!!
WS2.Select Range("K5").Select 'Data Field to Copy Selection.Copy WS1.Select Range("A8").Select 'First Cell on sheet where data needs to go do while isempty(selection) selection.offset(1,0).Select Loop ' I need this to look for the next blank cell on the page and then paste the value of ' The Data Field to Copy there. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Then on the same Row I need it to do the following.... 'If value of cell AV9=AX3 on WS2 it needs to copy value from WS2 cell AV70 to 'the same row in colum B. if Range("AV9").Value = ws2.Range("AX3").Value then ws2.Range("AV70").copy cells(selection.row,"B") End if 'END HELP NEEDED SECTION !!!! -- Regards, Tom Ogilvy "trward79" wrote: Here is the code I have now, and what I need it to do. Sub Data_Extract() Dim WS1 As Worksheet Dim WS2 As Worksheet Dim WS3 As Worksheet Dim WS4 As Worksheet Dim rng1 As Range Dim rng2 As Range Dim Str As String Set WS1 = Sheets("Summary") Set WS2 = Sheets("Credits") Set WS3 = Sheets("Payroll") Set WS4 = Sheets("Macros") WS3.Select Range("A5:AA1500").Select Selection.Copy WS4.Select Range("A1").Select ActiveSheet.Paste Do Until IsEmpty(ActiveCell) Set rng1 = WS4.Range("A2:AA1497").CurrentRegion Str = WS4.Range("C2").Value WS4.Select WS4.AutoFilterMode = Flase rng1.AutoFilter Field:=3, Criteria:=Str WIth WS4.AutoFilter.Range On Error Resume Next Set rng2 = .Offset(1,0).Resize(.Rows.Count - 1, .Columns.Count) .SpecialCells (xlCellTypeVariable) 'HERE IS WHERE I NEED HELP!!!!! WS2.Select Range("K5").Select 'Data Field to Copy Selection.Copy WS1.Select Range("A8").Select 'First Cell on sheet where data needs to go ' I need this to look for the next blank cell on the page and then paste the value of ' The Data Field to Copy there. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Then on the same Row I need it to do the following.... 'If value of cell AV9=AX3 on WS2 it needs to copy value from WS2 cell AV70 to 'the same row in colum B. 'END HELP NEEDED SECTION !!!! WS2.Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True WS2.Select Range("A10:AA69").ClearContents If Not rng2 Is Nothing Then rng2.Copy WS2.Range("A1" & LastRow(WS2) + 0) rng2.EntireRow.Delete End If End With WS4.AutoFilterMode = False WS4.Select Range("C2").Activate Loop End Sub Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", After:=sh.Range("A6:AA1497"), LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row On Error GoTo 0 End Function |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Next Cell Empty Issues
Tom,
It is not scrolling down to the next blank, but filling in Cell A8. The second issue is the value from AV70 is comming up as #REF because it is a formula, and changes. I need it to copy the value of cell AV70 to B. Any sugestions will help. And Thanks A Million for the help so far. "Tom Ogilvy" wrote: 'HERE IS WHERE I NEED HELP!!!!! WS2.Select Range("K5").Select 'Data Field to Copy Selection.Copy WS1.Select Range("A8").Select 'First Cell on sheet where data needs to go do while isempty(selection) selection.offset(1,0).Select Loop ' I need this to look for the next blank cell on the page and then paste the value of ' The Data Field to Copy there. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Then on the same Row I need it to do the following.... 'If value of cell AV9=AX3 on WS2 it needs to copy value from WS2 cell AV70 to 'the same row in colum B. if Range("AV9").Value = ws2.Range("AX3").Value then ws2.Range("AV70").copy cells(selection.row,"B") End if 'END HELP NEEDED SECTION !!!! -- Regards, Tom Ogilvy "trward79" wrote: Here is the code I have now, and what I need it to do. Sub Data_Extract() Dim WS1 As Worksheet Dim WS2 As Worksheet Dim WS3 As Worksheet Dim WS4 As Worksheet Dim rng1 As Range Dim rng2 As Range Dim Str As String Set WS1 = Sheets("Summary") Set WS2 = Sheets("Credits") Set WS3 = Sheets("Payroll") Set WS4 = Sheets("Macros") WS3.Select Range("A5:AA1500").Select Selection.Copy WS4.Select Range("A1").Select ActiveSheet.Paste Do Until IsEmpty(ActiveCell) Set rng1 = WS4.Range("A2:AA1497").CurrentRegion Str = WS4.Range("C2").Value WS4.Select WS4.AutoFilterMode = Flase rng1.AutoFilter Field:=3, Criteria:=Str WIth WS4.AutoFilter.Range On Error Resume Next Set rng2 = .Offset(1,0).Resize(.Rows.Count - 1, .Columns.Count) .SpecialCells (xlCellTypeVariable) 'HERE IS WHERE I NEED HELP!!!!! WS2.Select Range("K5").Select 'Data Field to Copy Selection.Copy WS1.Select Range("A8").Select 'First Cell on sheet where data needs to go ' I need this to look for the next blank cell on the page and then paste the value of ' The Data Field to Copy there. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Then on the same Row I need it to do the following.... 'If value of cell AV9=AX3 on WS2 it needs to copy value from WS2 cell AV70 to 'the same row in colum B. 'END HELP NEEDED SECTION !!!! WS2.Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True WS2.Select Range("A10:AA69").ClearContents If Not rng2 Is Nothing Then rng2.Copy WS2.Range("A1" & LastRow(WS2) + 0) rng2.EntireRow.Delete End If End With WS4.AutoFilterMode = False WS4.Select Range("C2").Activate Loop End Sub Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", After:=sh.Range("A6:AA1497"), LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row On Error GoTo 0 End Function |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Next Cell Empty Issues
'HERE IS WHERE I NEED HELP!!!!!
WS2.Select Range("K5").Select 'Data Field to Copy Selection.Copy WS1.Select Range("A8").Select 'First Cell on sheet where data needs to go do while NOT isempty(selection) selection.offset(1,0).Select Loop ' I need this to look for the next blank cell on the page and then paste the value of ' The Data Field to Copy there. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Then on the same Row I need it to do the following.... 'If value of cell AV9=AX3 on WS2 it needs to copy value from WS2 cell AV70 to 'the same row in colum B. if Range("AV9").Value = ws2.Range("AX3").Value then cells(selection.row,"B").Value = ws2.Range("AV70").Value End if 'END HELP NEEDED SECTION !!!! -- Regards, Tom Ogilvy "trward79" wrote: Tom, It is not scrolling down to the next blank, but filling in Cell A8. The second issue is the value from AV70 is comming up as #REF because it is a formula, and changes. I need it to copy the value of cell AV70 to B. Any sugestions will help. And Thanks A Million for the help so far. "Tom Ogilvy" wrote: 'HERE IS WHERE I NEED HELP!!!!! WS2.Select Range("K5").Select 'Data Field to Copy Selection.Copy WS1.Select Range("A8").Select 'First Cell on sheet where data needs to go do while isempty(selection) selection.offset(1,0).Select Loop ' I need this to look for the next blank cell on the page and then paste the value of ' The Data Field to Copy there. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Then on the same Row I need it to do the following.... 'If value of cell AV9=AX3 on WS2 it needs to copy value from WS2 cell AV70 to 'the same row in colum B. if Range("AV9").Value = ws2.Range("AX3").Value then ws2.Range("AV70").copy cells(selection.row,"B") End if 'END HELP NEEDED SECTION !!!! -- Regards, Tom Ogilvy "trward79" wrote: Here is the code I have now, and what I need it to do. Sub Data_Extract() Dim WS1 As Worksheet Dim WS2 As Worksheet Dim WS3 As Worksheet Dim WS4 As Worksheet Dim rng1 As Range Dim rng2 As Range Dim Str As String Set WS1 = Sheets("Summary") Set WS2 = Sheets("Credits") Set WS3 = Sheets("Payroll") Set WS4 = Sheets("Macros") WS3.Select Range("A5:AA1500").Select Selection.Copy WS4.Select Range("A1").Select ActiveSheet.Paste Do Until IsEmpty(ActiveCell) Set rng1 = WS4.Range("A2:AA1497").CurrentRegion Str = WS4.Range("C2").Value WS4.Select WS4.AutoFilterMode = Flase rng1.AutoFilter Field:=3, Criteria:=Str WIth WS4.AutoFilter.Range On Error Resume Next Set rng2 = .Offset(1,0).Resize(.Rows.Count - 1, .Columns.Count) .SpecialCells (xlCellTypeVariable) 'HERE IS WHERE I NEED HELP!!!!! WS2.Select Range("K5").Select 'Data Field to Copy Selection.Copy WS1.Select Range("A8").Select 'First Cell on sheet where data needs to go ' I need this to look for the next blank cell on the page and then paste the value of ' The Data Field to Copy there. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Then on the same Row I need it to do the following.... 'If value of cell AV9=AX3 on WS2 it needs to copy value from WS2 cell AV70 to 'the same row in colum B. 'END HELP NEEDED SECTION !!!! WS2.Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True WS2.Select Range("A10:AA69").ClearContents If Not rng2 Is Nothing Then rng2.Copy WS2.Range("A1" & LastRow(WS2) + 0) rng2.EntireRow.Delete End If End With WS4.AutoFilterMode = False WS4.Select Range("C2").Activate Loop End Sub Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", After:=sh.Range("A6:AA1497"), LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row On Error GoTo 0 End Function |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
IF function issues w/ empty cells | Excel Worksheet Functions | |||
Leaving an empty cell empty | Excel Discussion (Misc queries) | |||
why a reference to an empty cell is not considered empty | Excel Discussion (Misc queries) | |||
Finding next empty empty cell in a range of columns | Excel Programming | |||
Empty cell and a the empty String | Excel Programming |