Help with VBA code to search/compare and copy row

[Strugglestreet]

Hello everyone,

I am very new to VBA and am trying to create a piece of code (Button is in ASX workbook) that compares each row of data in column A of worksheet ASX300 with the data in worksheet Consumer Discretionary and if not found copy the entire row and display a text box highlighting new data has arrived. I've created the below code but i believe it needs the variables for the range and i haven't a clue what to do with it. If some can please help me that would be greatly appreciated! I have attached the spreadsheet as well.

Private Sub CommandButton1_Click()
With Sheets("ASX300").Range("A:A")
    Set Rng = .Find(What:=FindString, _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    If Not Rng Is Nothing Then
       
    Else
   
      Worksheets("Consumer discretionary").Activate
       b = Worksheets("Consumer Discretionary").Cells(Rows.Count, 1).End(xlUp).Row
       Worksheets("Consumer Discretionary").Cells(b + 1, 1).Select
       ActiveSheet.Paste
       
    MsgBox (New_Consumer_Discretionary_Item)
    End If
End With

Application.CutCopyMode = False

ThisWorkbook.Worksheets("ASX300").Cells(1, 1).Select

End Sub

 

[p45cal]

Let's see if I've got this right, you want to look down every ticker/symbol in column A of ASX300, and if it's not in column A of Consumer Discretionary, copy from ASX300 to Consumer Discretionary?

 

[Strugglestreet]

Yes that's right except it needs to only search Column A of ASX300 for the sectors with consumer discretionary in them. Then copy the ones to consumer discretionary that aren't already there. Does that make sense?

That code i sent is a nightmare. So many things wrong with it i think. I'm very very new to this!

 

[Logit]

This is one way :

Option Explicit

Sub CopyYes()
   
Dim ws, ws2 As Worksheet
Dim x As Integer
Dim ws2LR, NextRow As Range
Dim wsLR


Set ws = ThisWorkbook.Sheets("ASX300")
Set ws2 = ThisWorkbook.Sheets("Consumer Discretionary")

wsLR = ws.Cells(Rows.Count, 1).End(xlUp).Row
'ws2LR = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False

For x = 2 To wsLR
    'analyze date, see if it's 7 days old or less
    If ws.Cells(x, 3) = "Consumer Discretionary" Then
        'hide
        ws.Range("a" & x).EntireRow.Copy
        'ws2.Activate
        'ws2LR.Select
        ws2.Range("a" & x).PasteSpecial Paste:=xlValues
        '
        'Set NextRow = Nothing
     
    End If
Next x


Application.CutCopyMode = False
ws2.Activate
ws2.Range("A1").Select
Application.ScreenUpdating = True


DeleteMyRows

End Sub

Sub DeleteMyRows()

Dim Rng As Range, Cell As Range
Dim lr As Long, i As Long
Dim trm As String

Application.ScreenUpdating = False

lr = Sheets("Consumer Discretionary").Range("A" & Rows.Count).End(xlUp).Row

With Sheets("Consumer Discretionary")
    For i = lr To 2 Step -1
   
        If Range("A" & i) = "" Then
          Range("A" & i).EntireRow.Delete
        End If

    Next i
End With
Application.ScreenUpdating = True

End Sub

 

[Logit]

.
Here is a better macro :

Option Explicit

Sub CpyPasteTerm()
Dim strLastRow As String
    Dim rngC As Range
    Dim strToFind As String, FirstAddress As String
    Dim wSht As Worksheet
    Dim rngtest As String
    Application.ScreenUpdating = False
   
    Set wSht = Worksheets("Consumer Discretionary")
    strToFind = "Consumer Discretionary"
   
    With ActiveSheet.Range("C1:C1000")
        Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
            If Not rngC Is Nothing Then
                FirstAddress = rngC.Address
                Do
                    strLastRow = Worksheets("Consumer Discretionary").Range("A" & Rows.Count).End(xlUp).Row + 1
                    rngC.EntireRow.Copy wSht.Cells(strLastRow, 1)
                    Set rngC = .FindNext(rngC)
                Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
            End If
    End With
   
    MsgBox ("Finished")
End Sub

 

[Strugglestreet]

Thank you for the time that you have put into this, however it doesn't seem to work? It just keeps returning an invalid inside procedure. I tried to fix it but my knowledge is limited and can't seem to do it!

 

[Marc L]

Hi !

Like any beginner can operate manually just with an advanced filter
so according to your attachment as a beginner starter
paste this code to the Sheet16 module :​

Private Sub CommandButton1_Click()
    Dim R&
        Application.ScreenUpdating = False
    With Sheet1.Cells(1).CurrentRegion.Columns(1)
        [K2].Formula = "=AND(ISNA(MATCH(A2," & .Address(External:=True) & ",0)),C2=""" & .Parent.Name & """)"
        R = .Rows.Count + 1
    End With
    With [A1].CurrentRegion
        .AdvancedFilter xlFilterInPlace, [K1:K2]
        .Offset(1).Copy Sheet1.Cells(R, 1)
    End With
        [K2].Clear
        If Me.FilterMode Then Me.ShowAllData
        Application.ScreenUpdating = True
        If Sheet1.Cells(R, 1).Value > "" Then MsgBox "New data …", vbInformation, " Information"
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Logit]

.
Here is the complete code and the workbook attached :

Option Explicit

Sub CpyPasteTerm()
Dim strLastRow As String
    Dim rngC As Range
    Dim strToFind As String, FirstAddress As String
    Dim wSht As Worksheet
    Dim rngtest As String
    Application.ScreenUpdating = False
   
    Set wSht = Worksheets("Consumer Discretionary")
    strToFind = "Consumer Discretionary"
   
    With ActiveSheet.Range("C1:C1000")
        Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
            If Not rngC Is Nothing Then
                FirstAddress = rngC.Address
                Do
                    strLastRow = Worksheets("Consumer Discretionary").Range("A" & Rows.Count).End(xlUp).Row + 1
                    rngC.EntireRow.Copy wSht.Cells(strLastRow, 1)
                    Set rngC = .FindNext(rngC)
                Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
            End If
    End With
    remove
    MsgBox ("Finished")
End Sub


Sub remove()
Dim a As Long
Sheets("Consumer Discretionary").Activate
For a = Sheets("Consumer Discretionary").Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("A1:A" & a), Cells(a, 1)) > 1 Then Rows(a).Delete
Next
End Sub