Solved: Adding/Updating Main workbook..

[pookie62]

Hi,
I got an export.xls which contains partly different data every week.
Want to get it all together in one Main.xls
:think:
In the Main.xls I have column B= Vnaam(first name) and C =Naam(Last name).
Some of these names can be found in the export.xls, the next week the names may not be there, but other names are present.
ALL possible names are present in the Main.xls.Sheets"Leden",
same columns as the other sheets

If the name is in export.xls:ColumnB=Vnaam AND ColumnC=Naam,
Column E contains a value which I need transported to the main.xls, on the row with the name.

Layout of export.xls is always same, data differs.

Tricky part is that both workbooks have the four sheets where this code should look. Sheetnames are: OKP, SKP,OKR,SKR

Hopes this makes any sense and anyone wants to help me get this going.
Please ask if things are not clear, it's kind of hard to explain because it's rather complicated (imo)
:banghead:
Thanks !

[mdmackillop]

Hi Pookie,
Welcome to VBAX
Can you post a sample workbooks? Zip them and post using Manage Attachments in the Go Advanced section
Regards
MD

[pookie62]

Thanks for the welcome, will post attachments first thing tomorrow !
Have to decrease the size of them..

[pookie62]

Oke,
In the zip file you'll find the export.xls, main.xls and the add-in where all the data from export is processed.
When you added the Add-in you'll find ASN Code in the menu.Click to open the menu and click "Open Export" from it. Other two menucoptions have no code (yet) behind them.
Throw the two files main and export in the same Dir.

Please ask if more info is needed..
Cool Forum BTW !!
Thanks...

[mdmackillop]

f the name is in export.xls:ColumnB=Vnaam AND ColumnC=Naam,

Column E contains a value which I need transported to the main.xls, on the row with the name.
To which sheet?


Tricky part is that both workbooks have the four sheets where this code should look. Sheetnames are: OKP, SKP,OKR,SKR


Don't undestand this part. Only Main.xls contains these sheets, and these have Naam only.
Maybe you could add some data as it should output with comments as to where these have been copied.

[pookie62]

Hi again,

Did you add the xla and ran the code behind it ?
Then the export workbook gets the four sheets okp,skp etc added with the data that needs to be copied to the main.xls
I.e. If person A is on Export.xls!OKP then copy his points for OKP to Main.xls!OKP.
If his name is not there (on OKP sheet) add the name and plae points.

In this way I get a complete overview of points per match so I can build a competition over all matches of a year.

[mdmackillop]

If person A is on Export.xls!OKP then copy his points for OKP to Main.xls!OKP.
You only have one name column in Main OKP, but repeating names with different surnames in Export OKP.
Into which column are the points copied?


If his name is not there (on OKP sheet) add the name and plae points.


If the name (assumining duplicates fixed) is already there, where do the points go?

[pookie62]

Hi mdmackillop,
Sorry for being not clear..
I adjusted the Main.xsl this morning for attaching it here.
And forgot to create two clolumns for the names, like they appear in the export.xls

If the name (assumining duplicates fixed) is already there, where do the points go?
That's one of the problems..
Let say John Doe is already in the main.xls on the OKP sheet with some points from a previous match.(every match get it's own column on every sheet in main.xls).
Now we have again John Doe with some points, name already exists in main.xls on OKP sheet, but this matchpoints not...
How do we copy these points to the matchcolumn on his row(name) ??

You see how complex this is.. and very hard to explain.. so thanks again for your time and support ! Really need it...

[mdmackillop]

Finding the points and copying them to the same name in a corresponding sheet is not the problem if it is clear into which column. Where does the first result go? Into which columns do subsequent scores go? The next available one, or some other. Do they all go in the same column on the destination sheet? If you could be clear about this I'd know where to start.
Can you repost your corrected sheets with both names and some sample data in the destination sheets.

[pookie62]

Adjusted main.xls sheets okp and skp to give you an idea of how it should look.
I really appreciate your patience with me..:thumb

[mdmackillop]

Here's some code, but it's not 100%. There's a bit of repitition occurring. Maybe you can pin it down.

Option Explicit
Sub CopyScores()
Dim Arr, a
Dim WB As Workbook, ThsWB As Workbook
Dim WS As Worksheet
Dim cel As Range, c As Range
Dim NextCol As Range
Dim FirstAddress As String
Dim i As Long, j As Long, x As Long, col As Long
Dim Tgt As Range
Set ThsWB = ActiveWorkbook
Set WB = Workbooks("Main.xls")
Arr = Array("OKP", "SKP", "OKR", "SKR")
For Each a In Arr
FirstAddress = ""
i = 0
'MsgBox "sheet " & a
Set WS = WB.Sheets(a)
'Get next column to receive scores
WS.Activate
j = 5
Do
j = j + 1
x = Application.WorksheetFunction.CountA(WS.Range(Cells(4, j), Cells(Rows.Count, j)))
Loop Until x = 0

ThsWB.Sheets(a).Activate
For Each cel In ThsWB.Sheets(a).Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))
With WS.Columns(2)
'MsgBox cel
Set c = .Find(cel, after:=Cells(2, 2), lookat:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
If c.Offset(, 1) = cel.Offset(, 1) Then
i = i + 1
'copy scores to next column
cel.Offset(, 3).Copy c.Offset(, j - 2)
Set c = .FindNext(c)
Else
'Copy new names to bottom of existing list
WS.Activate
Set Tgt = WS.Cells(Rows.Count, 2).End(xlUp).Offset(1)
cel.Resize(, 2).Copy Tgt
'Copy scores to next column
cel.Offset(, 3).Copy Tgt.Offset(, j - 2)
Set c = .FindNext(c)
End If
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Next
Next
End Sub

[pookie62]

Maybe we can extract the matchname from export sheet ExportWedstrijdB:2 and copy this to the matchnames columns on all sheets, sort of When points are in this column, go to next column.
Perhaps build in a check if name is already in matchcolumn, don't add the name, find the name and add points..
(Just thinking out loud, wish I knew how to code this...):dunno
...And I'd have the matchname in the mainsheet..

I ran the code three times after each other without closing and points are copied to the next matchcolumn in main book, but also adds the name while it is already on the sheet (okp, skp etc) in the main book.

Other question: Since I have to run this code from Export to get the results, wouldn't it be better to run it from Main.xls ?
Export is changing (comes via email) and has the code not onboard.

Hope you're not bored with this yet..:bow:
I'm going to have weekend now (will have a quick peek later on)
Suggest you do the same !:beerchug:
I ow you a couple of these !!!!
:hi: Be back monday..

[mdmackillop]

Easy enough to run this from Main, once the functionality is fixed.
Try

see below

[mdmackillop]

Code revised to run from Main

Option Explicit
Sub CopyScores()
Dim Arr, a
Dim WB As Workbook, ThsWB As Workbook
Dim WS As Worksheet
Dim cel As Range, c As Range
Dim NextCol As Range
Dim FirstAddress As String
Dim i As Long, j As Long, x As Long, col As Long
Dim Tgt As Range, Found As Boolean
Dim ThsSht As Worksheet

Application.ScreenUpdating = False
Set ThsSht = ActiveSheet
Set ThsWB = ActiveWorkbook
Set WB = Workbooks("Export.xls")
Arr = Array("OKP", "SKP", "OKR", "SKR")
For Each a In Arr
FirstAddress = ""
i = 0
'MsgBox "sheet " & a
Set WS = ThsWB.Sheets(a)
'Get next column to receive scores
WS.Activate
j = 5
Do
j = j + 1
x = Application.WorksheetFunction.CountA(WS.Range(Cells(4, j), Cells(Rows.Count, j)))
Loop Until x = 0
WB.Sheets(a).Activate
For Each cel In WB.Sheets(a).Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))
With WS.Columns(2)
'MsgBox cel
Set c = .Find(cel, after:=Cells(2, 2), lookat:=xlWhole)
Found = False
If Not c Is Nothing Then
FirstAddress = c.Address
Do
If c.Offset(, 1) = cel.Offset(, 1) Then
i = i + 1
'copy scores to next column
cel.Offset(, 3).Copy c.Offset(, j - 2)
Found = True
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
'Name not found
If Found = False Then
'Copy new names to bottom of existing list
WS.Activate
Set Tgt = WS.Cells(Rows.Count, 2).End(xlUp).Offset(1)
cel.Resize(, 2).Copy Tgt
'Copy scores to next column
cel.Offset(, 3).Copy Tgt.Offset(, j - 2)
WB.Sheets(a).Activate
End If
End With
Next
Next
ThsSht.Activate
Application.ScreenUpdating = True
Set WB = Nothing
Set ThsWB = Nothing
Set WS = Nothing
Set cel = Nothing
Set c = Nothing
Set NextCol = Nothing
Set Tgt = Nothing
Set ThsSht = Nothing
End Sub

[pookie62]

Hi mdmackillop,
Just letting you know that all is running perfect !!
Thank you so very very much !!
A true GURU you are..:bow: