View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.misc
joel joel is offline
external usenet poster
 
Posts: 9,101
Default Merging two similar worksheets

The subscript out of Range is probably due to the worksheet names not
matching. If I knew which line was highlighted when the error occured it
would help.

I check for data being shuffled and do not see any problems. What I did in
the code is when the rows matched I copied the matched row to the new sheet
in the same workbook where it was located. This put the the data in Column C
in the newsheet of the same workbook. I then took the data in Column B in
both workbooks and put it in the newsheet in the other Workbook in column B.



"Ken" wrote:

Well it's close. With two small test files it worked OK with the caveat that
the correct results were found at the new sheet of the Comparebk file which
is opened by the macro but the results are shuffled wrong in the new sheet of
the ThisWorkbook file. When I tried it with the real files, one with 1376
rows and the other with 1076 rows, nothing was written and it gave an error
"Subscript out of range".

"Joel" wrote:

Try this. The macro will prompt for the compare file and then write to both
workbooks. The macro will leave both workbooks opend at the end and does not
save the files.

Sub CombineSheets()

filetoopen = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls")
If filetoopen = False Then
MsgBox ("Can't Open File, exiting Sub")
Exit Sub
End If

Set Comparebk = Workbooks.Open(Filename:=filetoopen)
Set CompareSht = Comparebk.Sheets("Sheet1")

With ThisWorkbook
Set NewSht1 = _
.Sheets.Add(after:=.Sheets(.Sheets.Count))
End With
With Comparebk
Set NewSht2 = _
.Sheets.Add(after:=.Sheets(.Sheets.Count))
End With

Set ThisSht = ThisWorkbook.Sheets("Sheet1")
With ThisSht
NewRowCount = 1
RowCount = 1
Do While .Range("A" & RowCount) < ""
MyDate = .Range("D" & RowCount).Text
Mytime = .Range("E" & RowCount).Text
Data = .Range("C" & RowCount).Text

CompareRowCount = 1
With CompareSht
Do While .Range("A" & CompareRowCount) < ""
CompareDate = .Range("D" & CompareRowCount).Text
CompareTime = .Range("E" & CompareRowCount).Text
CompareData = .Range("C" & RowCount).Text

If (MyDate = CompareDate) And _
(Mytime = CompareTime) Then

.Rows(CompareRowCount).Copy _
Destination:=NewSht2.Rows(NewRowCount)
NewSht2.Range("B" & NewRowCount) = Data
ThisSht.Rows(RowCount).Copy _
Destination:=NewSht1.Rows(NewRowCount)
NewSht1.Range("B" & NewRowCount) = CompareData
NewRowCount = NewRowCount + 1
End If

CompareRowCount = CompareRowCount + 1
Loop
End With

RowCount = RowCount + 1
Loop

End With

End Sub


"Ken" wrote:

Each sheet is in five columns with date and time at the end thusly:
2po228 placeholder 25.236200 9/2/2004 8:42:30 AM
2po228 placeholder 25.231090 9/2/2004 8:49:41 AM
2po228 placeholder 25.234030 9/2/2004 8:55:15 AM
Each sheet has different data in column 3. Placeholder is a blank reserved
column. The final sheet would look like the above excerpt except the
placeholder column will be populated with data from the other sheet whenever
date and time matched. The final sheet could be either a new sheet or a
modification of one of the originals, doesn't matter. Thanks

"Joel" wrote:

What rules should we use in combining the two rows? Which columns have Date
and times? Which columns do the results go in?

"Ken" wrote:

Greetings, I have two worksheets which are similar and each have date and
time column data headings in addition to other columns.

For every row which has a matching date and time in both worksheets, I would
like to combine the data for that row from both worksheets into another
worksheet.

For every row with a date and time in either worksheet that does not have a
match in the other, that row will be discarded.

Sound familiar to anyone? Thanks.