trying to match a cell value on another worksheet and copy the entire row onto another worksheet

Dave01

Board Regular
Joined
Nov 30, 2018
Messages
116
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Hi,

Ive been this all night and really not getting far, Ive been trying other peoples code out, and everything I try just doesnt do anything, I really dont know where I am going wrong.

I have two worksheets, a parked report worksheet where all the data is contained in a table. A formula in column AG will display the text Condition 1, and another worksheet called Condition 1.
I am trying to get VB code to work which looks for the text Condition 1 in the AG column, and copy the entire row into the condition 1 worksheet.

ideally I would like it to check Column AG in the Parked Report, for Condition 1 text, match it to my maintenance worksheet F6:F7, and if it matches, copies the entire row of the park report where Condition 1 appears into row 2 of Condition 1 report, and loop until the end of the data is reached.

I got this but like many VB I tried tonight, doesnt do anything. Im completed stuck, any help would be gratefully recived.

VBA Code:
Sub check_condition()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Parked Report").UsedRange.Rows.Count
    J = Worksheets("condition1").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Parked Report").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Parked Report").Range("AG2:AG" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Condition 1" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Parked Report6").Range("A" & J + 1)
'            xRg(K).EntireRow.delete
            If CStr(xRg(K).Value) = "condition1" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub


thanks

David
 
Last edited by a moderator:

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
I'm assuming that the "Condition 1" value that you are looking for is in Column AG.
In your row - xRg(K).EntireRow.Copy Destination:=Worksheets("Parked Report6").Range("A" & J + 1), you need to change "Parked Report6" to "condition1"
Then it works for me.
Probably also want to clear the data from condition1 worksheet when running the macro, as it just adds the same rows every time you run it
 
Upvote 0
Hi,

thanks for looking at this, it did copy the data, the problem is it copied all the data not just the condition 1 row data.

so blanks, condition 2 and value was picked up as well.
 
Upvote 0
Don't know what else I can say - with the table data and the code shown below, I run it and the Row Numbers 3, 7, 12 & 18 (The ones with the "Condition 1") are the only ones that copy across to the "condition1" tab. If not running Office 2016, what are you using, your profile isn't saying?

"Parked Report" Tab
Row numberData1Data2Output
1aa
2bb
3ccCondition 1
4dd
5ee
6ff
7ggCondition 1
8hh
9ii
10jj
11kk
12llCondition 1
13mm
14nn
15oo
16pp
17qq
18rrCondition 1
19ss
20tt


"condition1" Tab
Row numberData1Data2Output
3ccCondition 1
7ggCondition 1
12llCondition 1
18rrCondition 1


VBA Code
VBA Code:
Sub check_condition()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
   
    I = Worksheets("Parked Report").UsedRange.Rows.Count
    J = Worksheets("condition1").UsedRange.Rows.Count
    If J = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Parked Report").UsedRange) = 0 Then J = 0
    End If
   
'    Set xRg = Worksheets("Parked Report").Range("AG2:AG" & I)  ' commented out as I moved the "Condition 1" text into Column D
    Set xRg = Worksheets("Parked Report").Range("D2:D" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Condition 1" Then
            'xRg(K).EntireRow.Copy Destination:=Worksheets("Parked Report6").Range("A" & J + 1)  ' commented out as I changed for correct Tab name
            xRg(K).EntireRow.Copy Destination:=Worksheets("condition1").Range("A" & J + 1)
            ' xRg(K).EntireRow.delete
            If CStr(xRg(K).Value) = "condition1" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub
 
Last edited by a moderator:
Upvote 0
Solution
Hi, must have been something I did, I moved to a new excel sheet, pasted all the data and reran, worked perfectly,

thank you, Im not sure if tables has any thing to do with why it had issues the first time.

Im using Office 2016 Pro Plus.

thanks for your help.
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,696
Members
448,293
Latest member
jin kazuya

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top