Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 167
  • Last Modified:

Compare & Copy Specific Text Values

I have the following code that I would like to add critieria too, however I can not get it work based on what I added

Sub aaa()
  Dim ChkSH As Worksheet
  Set ChkSH = Sheets("LM")

    ce = "Local Market"
   
Sheets("Variance").Activate
  For Each ce In Range("a4:a" & Cells(Rows.Count, 1).End(xlUp).Row)
    Set findit = ChkSH.Range("a4:a3000").Find(what:=ce, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    If findit Is Nothing Then Range("A" & ce.Row).Copy _
        ChkSH.Range("a65000").End(xlUp).Offset(1, 0)

  Next ce
End Sub

Open in new window


From the Variance worksheet I want to only compare and copy over the rows where Column B text = Local Market.  As it is written I am returning all values in Column B.
0
jmac001
Asked:
jmac001
  • 4
  • 4
1 Solution
 
MacroShadowCommented:
Try this:
Sub aaa()
    Dim ChkSH As Worksheet
    Dim r As Row
    Dim ce As String

    Set ChkSH = Sheets("LM")
    ce = "Local Market"

    Sheets("Variance").Activate
    For Each r In Sheets("Variance").Range("a4:a" & Cells(Rows.Count, 1).End(xlUp).Row)
        Set findit = ChkSH.Range("a4:a3000").Find(what:=ce, LookIn:=xlValues, _
                                                  LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                                  MatchCase:=False, SearchFormat:=False)

        If findit Is Nothing Then Range("A" & ce.Row).Copy _
           ChkSH.Range("a65000").End(xlUp).Offset(1, 0)

    Next
End Sub

Open in new window

0
 
jmac001Author Commented:
Hi,

Receiving User-defined type not defined compile error (Dim r As Row).  Attaching a sample of the workbook vba in Module 4.

Thanks
EE-Timeline-Data-2014.04.29.xlsm
0
 
MacroShadowCommented:
Sorry my bad.

Sub aaa()
    Dim ChkSH As Worksheet
    Dim r As Range
    Dim ce As String

    Set ChkSH = Sheets("LM")
    ce = "Local Market"

    Sheets("Variance").Activate
    For Each r In Sheets("Variance").Range("a4:a" & Cells(Rows.Count, 1).End(xlUp).Row).Rows
        Set findit = ChkSH.Range("a4:a3000").Find(what:=ce, LookIn:=xlValues, _
                                                  LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                                  MatchCase:=False, SearchFormat:=False)

        If findit Is Nothing Then Range("A" & r.Row).Copy _
           ChkSH.Range("a65000").End(xlUp).Offset(1, 0)

    Next
End Sub

Open in new window

0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
jmac001Author Commented:
Still have a problem all of the records are still being copied over
0
 
MacroShadowCommented:
This is the quickest most efficient way to do what you want, it uses autofilter.

Sub aaa()
    Sheets("Variance").Range("A4:AC" & Cells(Rows.Count, 1).End(xlUp).Row).AutoFilter 2, "Local Market"
    Sheets("Variance").Range("A4:AC" & Cells(Rows.Count, 1).End(xlUp).Row).Copy Sheets("LM").Range("A65000").End(xlUp).Offset(1, 0)
    Sheets("Variance").ListObjects("Var").Range.AutoFilter Field:=2
End Sub

Open in new window

0
 
jmac001Author Commented:
This does workk.  In your opinion, I have to consistanly update the report, it better to copy and repaste the values or do a comparison and add only the new values?
0
 
MacroShadowCommented:
It will be much more efficient and a whole lot quicker to copy and paste all the the records.
0
 
jmac001Author Commented:
Thanks for you help and the alternative solution
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 4
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now