Copy data from one sheet to other sheets if certain cells contain data

mattadams84

Board Regular
Joined
Oct 30, 2016
Messages
54
Hello,

I am looking to create a VBA script that will copy over data from a range of cells to another sheet. The scenario i have is a spreadsheet that collates football match results from across the world. I have a sheet named "Latest Results" and then two other sheets, "O1.5" and "O2.5" which have all the results collated since i started collecting data. Each evening i add the next days matches to each sheet and at the end of the day once the matches have been played I use a piece of software which populates the latest results sheet and then i manually copy the results to the other two pages. However what i would like to do is have a macro that checks if a match has a result on the latest result page, then i would like it to copy that result in to the corresponding cells on the other two pages and then delete it from the latest results page.

So, 1 match equals one row and there are 4 columns which contain the match data : date, league, home team, away team. There are then 7 columns which contain the result data. I guess the macro would need to look at each row (match) on the latest result page, see if it has a result, and if it does, see if that row exists on the other two pages. If this is true then it would copy the 7 columns of result data over to the other two pages and then delete the row from the latest result page.

This is an exteremely complicated request so if anyone can help me i would be grateful. I have attached a link to my spreadsheet so you can see it more clearly.

https://1drv.ms/x/s!Aqt6z2wNNUtZg9d5YtUKvQ-1zFb-LA

Kind regards
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
12,750
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
Try this macro. It may take 5 seconds or more to run because it uses loops.
Code:
Sub CopyData()
    Application.ScreenUpdating = False
    Dim sAddr As String
    Dim x As Long
    Dim LastRow As Long
    LastRow = Sheets("Latest Results").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim visRng As Range
    Dim LastRow1 As Long
    LastRow1 = Sheets("O1.5").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim competition As Range
    Dim foundCompetition As Range
    Sheets("O1.5").Activate
    Range("AK4").Select
    Selection.AutoFilter
    ActiveSheet.Range("A1:A" & LastRow1).AutoFilter Field:=37, Criteria1:="="
    Set visRng = ActiveSheet.Range("C2:C" & LastRow1).SpecialCells(xlCellTypeVisible)
    For x = LastRow To 2 Step -1
        Set foundCompetition = visRng.Find(Sheets("Latest Results").Cells(x, "C"), LookIn:=xlValues, lookat:=xlWhole)
        If Not foundCompetition Is Nothing Then
            sAddr = foundCompetition.Address
            Do
                If Sheets("Latest Results").Cells(x, "D") = foundCompetition.Offset(0, 1) And Sheets("Latest Results").Cells(x, "E") = foundCompetition.Offset(0, 2) Then
                    Sheets("Latest Results").Range("F" & x & ":L" & x).Copy Sheets("O1.5").Range("AK" & foundCompetition.Row)
                    Sheets("Latest Results").Range("F" & x & ":L" & x).Copy Sheets("O2.5").Range("AK" & foundCompetition.Row)
                    Sheets("Latest Results").Rows(x).EntireRow.Delete
                End If
                Set foundCompetition = visRng.FindNext(foundCompetition)
            Loop While foundCompetition.Address <> sAddr
            sAddr = ""
        End If
    Next x
    Set foundCompetition = Nothing
    If Sheets("O1.5").FilterMode Then Sheets("O1.5").ShowAllData
    Application.ScreenUpdating = True
End Sub
 
Upvote 0

mattadams84

Board Regular
Joined
Oct 30, 2016
Messages
54
Hi mumps,

Wow! Many thanks for your response and for your code, it works! I do however notice one small problem which i dont know can be resolved. I have for example just updated the spreadsheet with the latest results. However there were 4 matches that have not finished so dont yet have a result. When i ran the macro is succusfully copied the results over to the other two pages, and deleted them from latest results, however the 4 matches that had no results on the latest results page also got deleted. Is there anyway to keep them there until they get a result?

Many, many thanks for your help!
 
Upvote 0

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
12,750
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
Replace this line:
Code:
If Sheets("Latest Results").Cells(x, "D") = foundCompetition.Offset(0, 1) And Sheets("Latest Results").Cells(x, "E") = foundCompetition.Offset(0, 2) Then
with this line:
Code:
If Sheets("Latest Results").Cells(x, "D") = foundCompetition.Offset(0, 1) And Sheets("Latest Results").Cells(x, "E") = foundCompetition.Offset(0, 2) And Sheets("Latest Results").Cells(x, "F") <> "" Then
 
Upvote 0

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
12,750
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
You are very welcome. :)
 
Upvote 0

Forum statistics

Threads
1,191,697
Messages
5,988,164
Members
440,131
Latest member
EricMoz

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
Top