Struggling to understand why code isn't working (search/copy/paste with matched criteria)

Thanks Thanks:  0
Likes Likes:  0
Page 1 of 2 12 LastLast
Results 1 to 10 of 12

Thread: Struggling to understand why code isn't working (search/copy/paste with matched criteria)

  1. #1
    Board Regular redspanna's Avatar
    Join Date
    Jul 2005
    Location
    Doha
    Posts
    1,366
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Struggling to understand why code isn't working (search/copy/paste with matched criteria)

     
    Hi all

    I have managed to piece together the code below from various sources on the net (as my code writing skills are poor)

    Code:
    Sub Add_Training_Records2()
    Application.ScreenUpdating = False
    Dim i As Long
    Dim wb As Workbook
    Dim Lastrow As Long
    Dim Lastrowa As Long
    
    Dim rFndCell As Range
    Dim strData As String
    Dim stFnd As String
    Dim Code As String
    Dim fCol As Integer
    Dim sh As Worksheet
    Dim ws As Worksheet
    Dim cell As Range
    
    Set ws = Sheets("Data2")
    Set sh = Sheets("Database2")
    stFnd = Sheets("Data2").Range("A3").Value
        
    
    For Each wb In Workbooks
    If wb.Name Like "all*" Then
    wb.Activate
    Range("A1:L8000").Select
    Selection.copy
    
    Workbooks("Tracker").Sheets("Data2").Activate
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("D:E").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "[$-409]d-mmm-yy;@"
    End If
    Next
    
    
    Sheets("Data2").Select
    For Each cell In ActiveSheet.Range("A3:A30")
    With sh
    Set rFndCell = .Range("A:A").Find(stFnd, LookIn:=xlValues)
    If Not rFndCell Is Nothing Then
    
    
    If Sheets("Data2").Range("B3").Value Like "*Complaint*" Then
    fCol = rFndCell.Row
    Sheets("Data2").Range("E3").copy sh.Cells(fCol, 7)
    Sheets("Data2").Select
    Rows("3:3").Select
    Selection.Delete Shift:=xlUp
    
    
    
    ElseIf Sheets("Data2").Range("B3").Value Like "Aviation*" Then
    fCol = rFndCell.Row
    Sheets("Data2").Range("E3").copy sh.Cells(fCol, 12)
    Sheets("Data2").Select
    Rows("3:3").Select
    Selection.Delete Shift:=xlUp
    
    
    ElseIf Sheets("Data2").Range("B3").Value Like "Dangerous*" Then
    fCol = rFndCell.Row
    Sheets("Data2").Range("E3").copy sh.Cells(fCol, 17)
    Sheets("Data2").Select
    Rows("3:3").Select
    Selection.Delete Shift:=xlUp
    
    
    End If
    Else
    End If
    End With
    Next cell
    
    
    End Sub
    So here is what I want the code to do...

    1) Go to another open workbook and copy selected data / paste this back into original workbook called Tracker - This part of code works fine
    2) Look at cell value of A3 in sheet Data2, go to Database2 sheet and find same number value through column A
    3) Once found (and there will always be a match) go back to Data2
    4) Check the data string in cell B3 and depending on result carry out slightly different task

    If B3 data string is likeComplaint (the string will always start with this word but others that follow are different eg Complaint Study , Complaint Group then
    copy the value of cell E3 and paste this into the same row where the earlier number value was matched with an offset of 7 columns
    so if originally the number value was found in cell A36 of Database2, then the value of cell E3 in Data2 will be pasted to G36

    or

    If B3 data string is likeAviation (the string will always start with this word but others that follow are different eg Aviation Study , Aviation Group then
    copy the value of cell E3 and paste this into the same row where the earlier number value was matched with an offset of 12 columns
    so if originally the number value was found in cell A36 of Database2, then the value of cell E3 in Data2 will be pasted to G36

    or

    If B3 data string is likeDangerous (the string will always start with this word but others that follow are different eg Dangerous Study , Dangerous Group then
    copy the value of cell B3 and paste this into the same row where the earlier number value was matched with an offset of 17 columns
    so if originally the number value was found in cell A36 of Database2, then the value of cell E3 in Data2 will be pasted to G36

    5) once these actions are complete, return to Data2 sheet and delete whole of row 3, thus moving next row of data to be checked up to Row 3
    6) Loop this sequence until there are no more values though column A in sheet Data2 to check.


    The code above doesn't seem to be looping properly as a result is only placed into one matched cell when clearly there are many

    Sorry for the long post but hope someone can look thru this as its driving me crazy and I'm sure there must be a simple explanation

    Many thanks in advance , yours hopefully

  2. #2
    Board Regular
    Join Date
    Feb 2003
    Posts
    1,470
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Struggling to understand why code isn't working (search/copy/paste with matched criteria)

    ok looking at your code I have some questions

    are sheets "Data2" and "Database2" both in workbook "Tracker"?
    will your range in "Data2" ever be longer than row 30?

    is the ws worksheet variable set to the same data2 as you are copying data into in the tracker workbook?

    Code:
    Set ws = Sheets("Data2")
    Set sh = Sheets("Database2")
    stFnd = Sheets("Data2").Range("A3").Value
        
    
    For Each wb In Workbooks
    If wb.Name Like "all*" Then
    wb.Activate
    Range("A1:L8000").Select
    Selection.copy
    
    Workbooks("Tracker").Sheets("Data2").Activate
    Last edited by RCBricker; Apr 21st, 2017 at 11:40 AM.
    Stolen from Micron

    Tips for posting problems:
    1) "doesn't work" is of no help. Post error message numbers and text, if known.
    2) if posting code or sql, use code tags; specify on which code line errors occur, if applicable
    3) try to be specific; assume we know nothing about your issue - because we don't!

    Make all suggested changes in copies of your database or to its objects.

    your title should be as descriptive as possible:
    i.e. VBA 2013 ERROR - object or variable not set issue

  3. #3
    Board Regular redspanna's Avatar
    Join Date
    Jul 2005
    Location
    Doha
    Posts
    1,366
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Struggling to understand why code isn't working (search/copy/paste with matched criteria)

    Hi and thanks so much for offer of help,

    are sheets "Data2" and "Database2" both in workbook "Tracker"?
    Yes, both in same workbook
    will your range in "Data2" ever be longer than row 30?
    yes, I was using 30 for my test VB, currently the range goes up to row 3976
    is the ws worksheet variable set to the same data2 as you are copying data into in the tracker workbook?
    The first part of the code goes to another workbook to copy data to be used in the Tracker workbook, once this data is copied (into Data2 sheet of Tracker) I no longer need the other workbook.
    Don't fully understand your question - sorry

    Really appreciate your help though

  4. #4
    Board Regular
    Join Date
    Feb 2003
    Posts
    1,470
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Struggling to understand why code isn't working (search/copy/paste with matched criteria)

    thanks you answered them all


    so the data is copied from the "all*" workbook and pasted in data2 in the tracker workbook. Then start in cell A3 (why A3?) find that value in database2 and change either the G, L or Q (depending on the starting word in B3 of data2) values in database2 to by inserting the value of data2 cell E3 into it.

    does that sum up what you need done?
    Stolen from Micron

    Tips for posting problems:
    1) "doesn't work" is of no help. Post error message numbers and text, if known.
    2) if posting code or sql, use code tags; specify on which code line errors occur, if applicable
    3) try to be specific; assume we know nothing about your issue - because we don't!

    Make all suggested changes in copies of your database or to its objects.

    your title should be as descriptive as possible:
    i.e. VBA 2013 ERROR - object or variable not set issue

  5. #5
    Board Regular redspanna's Avatar
    Join Date
    Jul 2005
    Location
    Doha
    Posts
    1,366
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Struggling to understand why code isn't working (search/copy/paste with matched criteria)

    Hi again

    so the data is copied from the "all*" workbook and pasted in data2 in the tracker workbook
    its actually pasted from a workbook called "all entries" however it could be changed so I wanted to use the first part as in all to activate the workbook. The data is copied and then pasted into Sheet Data2 of the 'Tracker' workbook
    Then start in cell A3 (why A3?)
    A3 holds the actual first number string that I want to use as the search criteria (these will always be 5 digit numbers)
    find that value in database2
    correct, through range A3:A500
    change either the G, L or Q (depending on the starting word in B3 of data2) values in database2 to by inserting the value of data2 cell E3 into it.
    correct.... example
    if B3 say holds the word Aviation Defence then data2 cell E3 will be pasted into the corresponding row matched / column G
    if B3 say holds the word Complaint process 2017 then data2 cell E3 will be pasted into the corresponding row matched / column L
    and so on......


    sorry for the excessive use of quotes but best way to explain everything,
    thanks once again and please feel free to ask any more questions if not sure

    Cheers

  6. #6
    Board Regular
    Join Date
    Feb 2003
    Posts
    1,470
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Struggling to understand why code isn't working (search/copy/paste with matched criteria)

    try this.

    I removed the row deletion till the end. then it clears all cells in data2.

    Code:
    Sub Add_Training_Records2()
    Application.ScreenUpdating = False
    Dim i As Long
    Dim wb As Workbook, wbTRACK As Workbook
    Dim Lastrow As Long
    Dim Lastrowa As Long
    Dim varI As Variant
    Dim rFndCell As Range
    Dim strData As String
    Dim stFnd As String
    Dim Code As String
    Dim fCol As Integer
    Dim sh As Worksheet
    Dim ws As Worksheet
    Dim cell As Range
    Dim rng As Range
    
        Set wbTRACK = ThisWorkbook
        Set ws = wbTRACK.Sheets("Data2")
        Set sh = wbTRACK.Sheets("Database2")
        
        For Each wb In Workbooks
            If wb.Name Like "all*" Then
                wb.Activate
                Range("A1:L8000").Copy
                ws.Range("A2").PasteSpecial xlPasteValues
                Application.CutCopyMode = False
                Columns("D:E").NumberFormat = "[$-409]d-mmm-yy;@"
            End If
        Next
        
        'ws.Select
        wbTRACK.Sheets(ws.Name).Activate
        Lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        Set rng = ws.Range(ws.Cells(3, 1), ws.Cells(Lastrow, 1))
        
        For i = Lastrow To 3 Step -1
    'ws.Cells(i, 1).Select
    'Debug.Print ws.Cells(i, 1).Address
    
            With sh
                stFnd = ws.Range("A" & i).Value
                Set rFndCell = sh.Range("A:A").Find(stFnd, LookIn:=xlValues)
                If Not rFndCell Is Nothing Then
                    Select Case UCase(Left(ws.Range("B" & i).Value, 3))
                        Case "COM"
                            varI = 7
                        Case "AVI"
                            varI = 12
                        Case "DAN"
                            varI = 17
                        Case Else
                            MsgBox "Cell B" & i & " value not normal, " _
                                & "check and start again!"
                            Exit Sub
                    End Select
                    sh.Cells(rFndCell.Row, varI).Value = ws.Range("E" & i).Value
                End If
            End With
        Next
        ws.Cells.Delete
    End Sub
    Stolen from Micron

    Tips for posting problems:
    1) "doesn't work" is of no help. Post error message numbers and text, if known.
    2) if posting code or sql, use code tags; specify on which code line errors occur, if applicable
    3) try to be specific; assume we know nothing about your issue - because we don't!

    Make all suggested changes in copies of your database or to its objects.

    your title should be as descriptive as possible:
    i.e. VBA 2013 ERROR - object or variable not set issue

  7. #7
    Board Regular redspanna's Avatar
    Join Date
    Jul 2005
    Location
    Doha
    Posts
    1,366
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Struggling to understand why code isn't working (search/copy/paste with matched criteria)

    ummmmm
    getting the message box appear saying
    Cell B2716 value not normal

    In B2716 of sheet Data2 there is normal data like all the other rows so I'm not sure why your code is failing
    Last edited by redspanna; Apr 21st, 2017 at 02:26 PM.

  8. #8
    Board Regular
    Join Date
    Feb 2003
    Posts
    1,470
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Struggling to understand why code isn't working (search/copy/paste with matched criteria)

    does b2716 have Complaint, Aviation or Dangerous in it?
    Stolen from Micron

    Tips for posting problems:
    1) "doesn't work" is of no help. Post error message numbers and text, if known.
    2) if posting code or sql, use code tags; specify on which code line errors occur, if applicable
    3) try to be specific; assume we know nothing about your issue - because we don't!

    Make all suggested changes in copies of your database or to its objects.

    your title should be as descriptive as possible:
    i.e. VBA 2013 ERROR - object or variable not set issue

  9. #9
    Board Regular redspanna's Avatar
    Join Date
    Jul 2005
    Location
    Doha
    Posts
    1,366
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Struggling to understand why code isn't working (search/copy/paste with matched criteria)

    No, but neither does many other cells in column B before B2716

    For example B827 has word being with Handling and B1236 word beginning with Safety
    Last edited by redspanna; Apr 21st, 2017 at 02:47 PM.

  10. #10
    Board Regular
    Join Date
    Feb 2003
    Posts
    1,470
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Struggling to understand why code isn't working (search/copy/paste with matched criteria)

      
    Quote Originally Posted by redspanna View Post
    If B3 data string is likeComplaint (the string will always start with this word but others that follow are different eg Complaint Study , Complaint Group then
    copy the value of cell E3 and paste this into the same row where the earlier number value was matched with an offset of 7 columns
    so if originally the number value was found in cell A36 of Database2, then the value of cell E3 in Data2 will be pasted to G36

    or

    If B3 data string is likeAviation (the string will always start with this word but others that follow are different eg Aviation Study , Aviation Group then
    copy the value of cell E3 and paste this into the same row where the earlier number value was matched with an offset of 12 columns
    so if originally the number value was found in cell A36 of Database2, then the value of cell E3 in Data2 will be pasted to G36

    or

    If B3 data string is likeDangerous (the string will always start with this word but others that follow are different eg Dangerous Study , Dangerous Group then
    copy the value of cell B3 and paste this into the same row where the earlier number value was matched with an offset of 17 columns
    so if originally the number value was found in cell A36 of Database2, then the value of cell E3 in Data2 will be pasted to G36
    ok based on the above from your instruction, it sounded like there would never be a situation in which one of the above three did not happen.

    The code is doing what it is supposed to do.

    What is needed is an understanding as to what the code should do if none of the three above situations is true.

    ******edit

    based on your original code it looks like you do not want anything to happen if none of the situations are true. that includes deleting the rows.

    so here is code that will ignore any row that does not meet those situations.

    Code:
    Sub Add_Training_Records2()
    Application.ScreenUpdating = False
    Dim i As Long
    Dim wb As Workbook, wbTRACK As Workbook
    Dim Lastrow As Long
    Dim Lastrowa As Long
    Dim varI As Variant
    Dim rFndCell As Range
    Dim strData As String
    Dim stFnd As String
    Dim Code As String
    Dim fCol As Integer
    Dim sh As Worksheet
    Dim ws As Worksheet
    Dim cell As Range
    Dim rng As Range
    
        Set wbTRACK = ThisWorkbook
        Set ws = wbTRACK.Sheets("Data2")
        Set sh = wbTRACK.Sheets("Database2")
        
        For Each wb In Workbooks
            If wb.Name Like "all*" Then
                wb.Activate
                Range("A1:L8000").Copy
                ws.Range("A2").PasteSpecial xlPasteValues
                Application.CutCopyMode = False
                Columns("D:E").NumberFormat = "[$-409]d-mmm-yy;@"
            End If
        Next
        
        'ws.Select
        wbTRACK.Sheets(ws.Name).Activate
        Lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        Set rng = ws.Range(ws.Cells(3, 1), ws.Cells(Lastrow, 1))
        
        For i = Lastrow To 3 Step -1
    'ws.Cells(i, 1).Select
    'Debug.Print ws.Cells(i, 1).Address
    
            With sh
                stFnd = ws.Range("A" & i).Value
                Set rFndCell = sh.Range("A:A").Find(stFnd, LookIn:=xlValues)
                If Not rFndCell Is Nothing Then
                    Select Case UCase(Left(ws.Range("B" & i).Value, 3))
                        Case "COM"
                            varI = 7
                        Case "AVI"
                            varI = 12
                        Case "DAN"
                            varI = 17
                    End Select
                    sh.Cells(rFndCell.Row, varI).Value = ws.Range("E" & i).Value
                End If
            End With
            ws.Cells(i, 1).EntireRow.Delete
        Next
    End Sub
    if you want something else to happen let me know and I will fix the code Monday.

    Have a good weekend.
    Last edited by RCBricker; Apr 21st, 2017 at 03:00 PM.
    Stolen from Micron

    Tips for posting problems:
    1) "doesn't work" is of no help. Post error message numbers and text, if known.
    2) if posting code or sql, use code tags; specify on which code line errors occur, if applicable
    3) try to be specific; assume we know nothing about your issue - because we don't!

    Make all suggested changes in copies of your database or to its objects.

    your title should be as descriptive as possible:
    i.e. VBA 2013 ERROR - object or variable not set issue

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

 

 
DMCA.com