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

redspanna

Well-known Member
Joined
Jul 27, 2005
Messages
1,602
Office Version
  1. 365
Platform
  1. Windows
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 :(
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
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:
Upvote 0
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
 
Upvote 0
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?
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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:
Upvote 0
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:
Upvote 0
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:
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,034
Members
448,543
Latest member
MartinLarkin

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