I am trying to create a method for checking particular column in range for blanks. Then if column is not blank I would like to copy all values from that row to another Worksheet.
Now I am completely stuck. Anybody can give some hint how to proceed with the loop in order to achieve result as on the screenshot below?
In example below I need to copy:
In my current code If statement basically does not work as an output I get all rows to Debug window.
Here is the code (method):
Sub CopyTimeScheduleMethod(SearchWordOne As String, SearchWordTwo As String, RowToPaste As Integer, OperatingWorksheet As Worksheet)
Dim FirstWord, SecondWord
Dim cell As Range
Dim rng As Range
Dim row As Range
Set FirstWord = OperatingWorksheet.Range("A:A").Find(SearchWordOne, LookIn:=xlValues, lookat:=xlWhole)
Set SecondWord = OperatingWorksheet.Range("A:A").Find(SearchWordTwo, LookIn:=xlValues, lookat:=xlWhole)
Set rng = OperatingWorksheet.Range(OperatingWorksheet.Cells(FirstWord.row + 2, FirstWord.Column), _
OperatingWorksheet.Cells(SecondWord.row - 3, FirstWord.Column))
ThisWorkbook.Worksheets("Timeschedule").Range("A8:G90").ClearContents
For Each row In rng.Rows
For Each cell In row.Cells
If IsEmpty(cell.Offset(rowOffset:=0, columnOffset:=21).Value) And _
Not IsEmpty(cell.Offset(rowOffset:=0, columnOffset:=1).Value) Then
Debug.Print cell.Offset(rowOffset:=0, columnOffset:=1).Value
End If
Next cell
Next row
End Sub
As an output I get:
1.1
1.1.2.1
How I can build my If statement to have 1 Task
as well for first column and second (B and C) column but exclude it from other Columns (E, F and G)?
Here is the range on rng.Copy
(From here I need to copy):
Here is how it should look like on another Worksheet:
EDIT:
This is now working as it should, but there is still a problem with first "Header" row. How to catch it? One option is of course to just remove "OPT" from Source Worksheet, from Column V.
Sub CopyTimeScheduleMethod(SearchWordOne As String, SearchWordTwo As String, RowToPaste As Integer, OperatingWorksheet As Worksheet)
Dim FirstWord, SecondWord
Dim cell As Range
Dim rng As Range
Dim row As Range
Dim x
Set FirstWord = OperatingWorksheet.Range("A:A").Find(SearchWordOne, LookIn:=xlValues, lookat:=xlWhole)
Set SecondWord = OperatingWorksheet.Range("A:A").Find(SearchWordTwo, LookIn:=xlValues, lookat:=xlWhole)
Set rng = OperatingWorksheet.Range(OperatingWorksheet.Cells(FirstWord.row + 2, FirstWord.Column), _
OperatingWorksheet.Cells(SecondWord.row - 3, FirstWord.Column))
ThisWorkbook.Worksheets("Timeschedule").Range("A8:G90").ClearContents
x = 8
For Each row In rng.Rows
For Each cell In row.Cells
If IsEmpty(cell.Offset(rowOffset:=0, columnOffset:=21).Value) And _
Not IsEmpty(cell.Offset(rowOffset:=0, columnOffset:=2).Value) Then
Debug.Print cell.Offset(rowOffset:=0, columnOffset:=1).Value
ThisWorkbook.Worksheets("Timeschedule").Range("A" & x).Value _
= cell.Offset(rowOffset:=0, columnOffset:=1).Value
ThisWorkbook.Worksheets("Timeschedule").Range("B" & x).Value _
= cell.Offset(rowOffset:=0, columnOffset:=2).Value
ThisWorkbook.Worksheets("Timeschedule").Range("C" & x).Value _
= cell.Offset(rowOffset:=0, columnOffset:=4).Value
ThisWorkbook.Worksheets("Timeschedule").Range("D" & x).Value _
= cell.Offset(rowOffset:=0, columnOffset:=5).Value
ThisWorkbook.Worksheets("Timeschedule").Range("E" & x).Value _
= cell.Offset(rowOffset:=0, columnOffset:=6).Value
x = x + 1
End If
Next cell
Next row
End Sub
Basically what is still left to solve is how to make If statement where:
cell in column C is not empty
cell in column V is not empty or not "OPT"
If IsEmpty(cell.Offset(rowOffset:=0, columnOffset:=21).Value) And _ cell.Offset(rowOffset:=0, columnOffset:=21).Value <> "OPT" And _ Not IsEmpty(cell.Offset(rowOffset:=0, columnOffset:=2).Value) Then
Here is working solution:
Sub CopyTimeScheduleMethod(SearchWordOne As String, SearchWordTwo As String, RowToPaste As Integer, OperatingWorksheet As Worksheet)
Dim FirstWord, SecondWord
Dim cell As Range
Dim rng As Range
Dim row As Range
Dim x As Integer
Set FirstWord = OperatingWorksheet.Range("A:A").Find(SearchWordOne, LookIn:=xlValues, lookat:=xlWhole)
Set SecondWord = OperatingWorksheet.Range("A:A").Find(SearchWordTwo, LookIn:=xlValues, lookat:=xlWhole)
Set rng = OperatingWorksheet.Range(OperatingWorksheet.Cells(FirstWord.row + 2, FirstWord.Column), _
OperatingWorksheet.Cells(SecondWord.row - 3, FirstWord.Column))
ThisWorkbook.Worksheets("Timeschedule").Range("A8:G90").ClearContents
x = 8
For Each row In rng.Rows
For Each cell In row.Cells
If Not IsEmpty(cell.Offset(rowOffset:=0, columnOffset:=2).Value) And _
(cell.Offset(rowOffset:=0, columnOffset:=21).Value = "OPT" Or _
IsEmpty(cell.Offset(rowOffset:=0, columnOffset:=21).Value)) Then
'Debug.Print cell.Offset(rowOffset:=0, columnOffset:=1).Value
ThisWorkbook.Worksheets("Timeschedule").Range("A" & x).Value _
= cell.Offset(rowOffset:=0, columnOffset:=1).Value
ThisWorkbook.Worksheets("Timeschedule").Range("B" & x).Value _
= cell.Offset(rowOffset:=0, columnOffset:=2).Value
ThisWorkbook.Worksheets("Timeschedule").Range("C" & x).Value _
= cell.Offset(rowOffset:=0, columnOffset:=4).Value
ThisWorkbook.Worksheets("Timeschedule").Range("D" & x).Value _
= cell.Offset(rowOffset:=0, columnOffset:=5).Value
ThisWorkbook.Worksheets("Timeschedule").Range("E" & x).Value _
= cell.Offset(rowOffset:=0, columnOffset:=6).Value
x = x + 1
End If
Next cell
Next row
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.