i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
I think I've worked out half of the problem. On the sheet3, I'm using formula from http://www.cpearson.com/excel/ListFunctions.aspx which outputs the unique entries in column b from sheets 1 and 2. Then I do another filter to get the unique entries from sheets 1 and 2 combined. Then I do another filter to get the non-blank entries at the top and the blank entries after that.
The next stage I need to work out is how to use the entry in the list to sum the values from sheets 1 and 2.
the piece of origami as sugested works fine in mso2007
Code:
Sub sort_all(sheet As Worksheet)
i = freespace(sheet)
Cells.Select
sheet.Sort.SortFields.Clear
sheet.Sort.SortFields.Add Key:=Range("b1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With sheet.Sort
.SetRange Range("A1:B" & i)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Function freespace(sheet As Worksheet) As Long
sheet.Select
Range("b1").Select
While Selection.Value > ""
Selection(2, 1).Select
'Debug.Print Selection.Address
Wend
freespace = Selection.Row
End Function
Sub copy_values(sheet1 As Worksheet, sheet2 As Worksheet)
i = freespace(sheet1) - 1
sheet1.Select
Range("A2:B" & i).Select
Selection.Copy
sheet2.Select
j = freespace(sheet2)
Range("A" & j).Select
sheet2.Paste
End Sub
Sub copy_sheets(sheet1 As Worksheet, sheet2 As Worksheet, sheet3 As Worksheet)
i = sheet1.Index
j = sheet2.Index
For s = i To j
copy_values Sheets(s), Sheets("summary")
Next s
sort_all sheet3
End Sub
Sub sumation()
copy_sheets Sheets("sheet1"), Sheets("sheet2"), Sheets("summary")
i = freespace(Sheets("summary")) - 1
For j = 1 To i
Range("c" & j).Value = "=sumif(b:b,b" & j & ",a:A)"
Next j
'do cut and paste_special- force values only
Range("a1:c" & i).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'remove column"a"
Range("a:a").Select
Selection.Delete
Stop
'remove duplicates
j = 1
While j < i
If Range("a" & j).Value = Range("a" & j + 1).Value Then
Range(j + 1 & ":" & j + 1).Delete
i = i - 1
Else
j = j + 1
End If
Wend
End Sub
call using sumation with the sheet names or sheet index
sumation sheet1,sheet2,summationsheet
process will produce sumation of types in 2 columns at head of summationsheet
you may need to modify to make pretty
notes available (if needed)
here to help
do not forget to rate post that are helpful and close the thread using tools from the top bar