Can I split&write data to each individual sheet?

[Tom Ogilvy]

Is it possible using macros?

Yes, it should be possible.

 

[Martyn]

Thanks for your reply Tom,
I should have clarified that I am also looking for a solution suggestion..
And can you/or other interested experts please suggest a VBA code that can
do the trick?
TIA
Martyn

 

[Tom Ogilvy]

it should go something like this.

Dim bk1 as workbook, bk2 as workbook
Dim sh as worksheet, cell as range, rng as Range
Dim rng1 as Range, res as Variant
set bk1 = Workbooks("All_data.xls")
set bk2 = workbooks("Reports.xls")
set rng = bk1.Range(bk1.Cells(2,1),bk1.Cells(2,1).End(xldown))
for each cell in rng
set sh = Bk2.Worksheets(cell.offset(0,1).value)
set rng1 = sh.Range(sh.cells(2,"H"),sh.Cells(2,"H").End(xldown))
res = Application.Match(clng(cell.offset(0,7)),rng1,0)
if iserror(res) then
cell.Entirerow.copy
Destination:=rng1.offset(rng1.rows.count,0).Resize(1,1)
end if
Next

 

[Martyn]

Hi Tom,
I used the code in the "Reports.xls" file with the All_data.xls file open
but
Received an Compile error "Invalid Outside Procedure" for the line
Set bk1 = Workbooks("All_data.xls")
Should the code reside on a seperate file?

 

[Tom Ogilvy]

No, you need to put it in a procedure:

Sub Tester1()
Dim bk1 as workbook, bk2 as workbook
Dim sh as worksheet, cell as range, rng as Range
Dim rng1 as Range, res as Variant
set bk1 = Workbooks("All_data.xls")
set bk2 = workbooks("Reports.xls")
set rng = bk1.Range(bk1.Cells(2,1),bk1.Cells(2,1).End(xldown))
for each cell in rng
set sh = Bk2.Worksheets(cell.offset(0,1).value)
set rng1 = sh.Range(sh.cells(2,"H"),sh.Cells(2,"H").End(xldown))
res = Application.Match(clng(cell.offset(0,7)),rng1,0)
if iserror(res) then
cell.Entirerow.copy _
Destination:=rng1.offset( _
rng1.rows.count,0).Resize(1,1)
end if
Next
End Sub

I didn't put it in a procedure because I don't want to create the impression
I bench tested it - I did not, so it may contain typos but represents an
approach. It is assumed you can fine tune it to meet your needs.

--
Regards,
Tom Ogilvy

Hi Tom,
I used the code in the "Reports.xls" file with the All_data.xls file open
but
Received an Compile error "Invalid Outside Procedure" for the line
Set bk1 = Workbooks("All_data.xls")
Should the code reside on a seperate file?

 

[Martyn]

Hi experts,

I have two workbooks. "All_data.xls" have 11 columns (A:K) where on column
B, I have names and on column H dates. This workbook keeps growing as we add
up new occasions.
On the other hand the other workbook "Reports.xls" have sheet names all with
the same names used (or to be used) on column B of "All_data.xls". Now I
need to be able to read data (any time) from "All_data.xls", check the names
(cell B value) and dates (cell H value) for the same line, and if both the
name and date are not written for that individual sheet (sheet with the same
name) "Reports.xls", write all the line info from "All_data.xls" to the
first available empty line of "Report.xls". Since there is no chance of
duplicates for names & dates, this way only non-repeated entried will be
written to "Report.xls".

Is it possible using macros?

Thanks in advance
Martyn

 

[Martyn]

Dear Tom,
I put it in a procedure but still get the compiler error...Unfortunately I
am almost a newbee with VBA programming. Thus I am stuck with my problem.
Help will be appreciated.

No, you need to put it in a procedure:

Sub Tester1()
Dim bk1 as workbook, bk2 as workbook
Dim sh as worksheet, cell as range, rng as Range
Dim rng1 as Range, res as Variant
set bk1 = Workbooks("All_data.xls")
set bk2 = workbooks("Reports.xls")
set rng = bk1.Range(bk1.Cells(2,1),bk1.Cells(2,1).End(xldown))
for each cell in rng
set sh = Bk2.Worksheets(cell.offset(0,1).value)
set rng1 = sh.Range(sh.cells(2,"H"),sh.Cells(2,"H").End(xldown))
res = Application.Match(clng(cell.offset(0,7)),rng1,0)
if iserror(res) then
cell.Entirerow.copy _
Destination:=rng1.offset( _
rng1.rows.count,0).Resize(1,1)
end if
Next
End Sub

I didn't put it in a procedure because I don't want to create the impression
I bench tested it - I did not, so it may contain typos but represents an
approach. It is assumed you can fine tune it to meet your needs.

 

[Tom Ogilvy]

I pasted the code from the email in a general module and compiled it. I had
no errors.

 

[Dave Peterson]

A couple modifications of Tom's routine and it worked ok for me:

Option Explicit

Sub Tester1()
Dim wk1 As Worksheet, bk2 As Workbook
Dim sh As Worksheet, cell As Range, rng As Range
Dim rng1 As Range, res As Variant
Set wk1 = Workbooks("All_data.xls").Worksheets("sheet1")
Set bk2 = Workbooks("Reports.xls")
Set rng = wk1.Range(wk1.Cells(2, 1), wk1.Cells(2, 1).End(xlDown))
For Each cell In rng
Set sh = bk2.Worksheets(cell.Offset(0, 1).Value)
Set rng1 = sh.Range(sh.Cells(2, "H"), sh.Cells(2, "H").End(xlDown))
res = Application.Match(CLng(cell.Offset(0, 7)), rng1, 0)
If IsError(res) Then
cell.EntireRow.Copy _
Destination:=rng1.Offset( _
rng1.Rows.Count, 0).Resize(1, 1).EntireRow.Cells(1)
End If
Next cell
End Sub

But you'll have to adjust the name of the worksheet that contains the names--I
used Sheet1.

 

[Martyn]

Thanks Dave,
but I keep getting a "subscript out of range" error from the compiler on
line
Set wk1 = Workbooks("All_data.xls").Worksheets("sheet1")
I am stuck. Hope I can find out why...
But thank you anyway.
Martyn

 

[Haldun Alay]

Are you sure that both workbooks are opened when you run the macro?

--
Haldun Alay


"Martyn" <[email protected]>, iletide þunu yazdý
Thanks Dave,
but I keep getting a "subscript out of range" error from the compiler on
line
Set wk1 = Workbooks("All_data.xls").Worksheets("sheet1")
I am stuck. Hope I can find out why...
But thank you anyway.
Martyn

 

[Martyn]

Yes Haldun both workbooks are open when the macro is runned.

 

[Dave Peterson]

I put this note in my response:

But you'll have to adjust the name of the worksheet that contains the names--I
used Sheet1.

This is the spot that you specify the workbook and worksheet:
Set wk1 = Workbooks("All_data.xls").Worksheets("sheet1")

 

[Myrna Larson]

This means that you have used an incorrect name for either the workbook or the
worksheet.

 

[Jack]

I think you were correct with your assumption on worksheet names but
although am sure about the one I tried, I also did get a "subscript out of
range" error for the line:
Set sh = bk2.Worksheets(cell.Offset(0, 1).Value)
J.

 

[Dave Peterson]

put this line right before the offending line:

msgbox "***" & cell.offset(0,1).value & "***"

Do you see what you expected between the ***'s?

 

[Jack]

Hi Dave,
Yes I do see what I expect between the ***'s.
But when I OK pass the msgbox I receive the same old error.
Hope we can solve this puzzle
Thanks

put this line right before the offending line:

msgbox "***" & cell.offset(0,1).value & "***"

Do you see what you expected between the ***'s?

I think you were correct with your assumption on worksheet names but
although am sure about the one I tried, I also did get a "subscript out of
range" error for the line:
Set sh = bk2.Worksheets(cell.Offset(0, 1).Value)
J.

This means that you have used an incorrect name for either the

workbook or
the

worksheet.

 

[Dave Peterson]

And you're sure that name matches a worksheet name in wb2?

Maybe leading/trailing/extra spaces????

Hi Dave,
Yes I do see what I expect between the ***'s.
But when I OK pass the msgbox I receive the same old error.
Hope we can solve this puzzle
Thanks

put this line right before the offending line:

msgbox "***" & cell.offset(0,1).value & "***"

Do you see what you expected between the ***'s?

 

[Jack]

Hi Dave,
Yes it looks like the name matches the worksheet name. Would it be a good
idea if I email you the two files and see if you can work it out?. If so,
please let me know which email add. I should use...
Sincerely
J.

And you're sure that name matches a worksheet name in wb2?

Maybe leading/trailing/extra spaces????

 

[Dave Peterson]

Before you send anything, what's the name of the worksheet?

And try this:
Open your workbook (all_data.xls--that is the correct name for the workbook???)
then create a new test macro:

option explicit
sub test01()
workbooks("all_data.xls").worksheets("whateveryoucalledit").select
end sub

And post back what happens.

Hi Dave,
Yes it looks like the name matches the worksheet name. Would it be a good
idea if I email you the two files and see if you can work it out?. If so,
please let me know which email add. I should use...
Sincerely
J.