logical function template

[SJay]

I have two different data sets with the following characteristics:

Data set 1: Brand names (e.g. Coca Cola) in Column A with an accompanying
number in Column B.

Data set 2: Brand names in Column C with an accompanying number in Column D.

The numbers which accompany each brand name are different. Some brands are
listed in both data sets, and some are listed in one data set or the other.

I want to create a list in which all the brands across both counts are
listed once in one column, with the accompanying number from both data sets
in the corresponding cells.

Where a Brand is counted in one data set and not the other, it will list the
number for the data set in which it was registered, and a zero for the data
set where it was not counted. Where a brand is counted in both data sets, it
will list both numbers next to the brand, cancelling out the need to list the
brand name twice.

I can do all of the above by messing around with VLOOKUP and IF functions,
but I want to try and create a template so that I can plug in two different
data sets from multiple sources. Then, the worksheet will immediately convert
the two counts into one list with the corresponding numbers from both counts
associated with each brand.

I hope this made sense! Let me know if there's anything that can be done.

Cheers,
SJay

 

[Joel]

The code copies columns A & B then checks if the Brands in column c exists.
If it exists then it puts the number in column c, otherwise, it adds a new
row and puts the Brand in column A and the number in column C.

Sub combinelist()

Set NewSht = ThisWorkbook.Sheets("Sheet1")

'OPen Workbook
FileToOpen = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls")
If FileToOpen = False Then
MsgBox ("Can't Open file - Exit sub")
Exit Sub
End If

Set OldBk = Workbooks.Open(Filename:=FileToOpen)
Set OldSht = OldBk.Sheets("sheet1")

With OldSht
'copy columns A and B
.Columns("A:B").Copy _
Destination:=NewSht.Columns("A:B")
NewRow = NewSht.Range("A" & Rows.Count).End(xlUp).Row + 1

LastRow = .Range("C" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
If .Range("C" & RowCount) <> "" Then
Brand = .Range("C" & RowCount)
Number = .Range("D" & RowCount)

With NewSht
'check if brand exist already
Set c = .Columns("A").Find(what:=Brand, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
.Range("A" & NewRow) = Brand
.Range("C" & NewRow) = Number
NewRow = NewRow + 1
Else
.Range("C" & c.Row) = Number
End If

End With
End If
Next RowCount
End With
OldBk.Close savechanges:=False
End Sub

 

[SJay]

Hi Joel, thanks for your response. Based on your explanation, you've
definitely identified exactly what I want to do.

I'm pretty much a novice with Visual Basic, so I tried entering the code and
it didn't work the first time. I think the problem is in the following
section:

'OPen Workbook
FileToOpen = Application _
.GetOpenBook1("Excel Files (*.xls), *.xls")
If FileToOpen = False Then
MsgBox ("Can't Open file - Exit sub")
Exit Sub
End If

Set OldBk = Workbooks.Open(Book1.xls:=FileToOpen)
Set OldSht = OldBk.Sheets("sheet1")

The code sequence above - Set OldBk = Workbooks.Open(Book1.xls:=FileToOpen)
-was highlighted in red, so I'm not sure if that's where the program has
identified the error.

Is there anything basic that I'm missing here? e.g. do I need to type in the
name of my workbook into the code or something like that?

 

[Bob Phillips]

That should be

Set OldBk = Workbooks.Open(Filename:=FileToOpen)


--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[SJay]

Yeah I forgot I'd changed that from the original. When I fixed that and ran
the macro the following box popped up:

Run-time error '438'
Object doesn't support this property or method

Let me know if this is a standard error and easy to fix. Cheers

 

[Joel]

Not usre where you are getting the error or what code you have changed. The
original code brought up a pop up window to allow you to select the file with
your original data. You didn't need to change it to book1.xls.