简体   繁体   中英

Perform check on two columns, Copy column by column another Worksheet

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:

  1. From Column B rows 19, 20, 22 to another sheet Column A (starting from A8)
  2. From Column C rows 19, 20, 22 to another sheet Column B (starting from B8)
  3. From Column E rows 20, 22 to another sheet Column C (starting from C9)
  4. From Column F rows 20, 22 to another sheet Column D (starting from D9)
  5. From Column G rows 20, 22 to another sheet Column E (starting from E9)

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:

  1. cell in column C is not empty

  2. 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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM