I need a macro please [Solved/Closed]

Report
Posts
2
Registration date
Tuesday December 23, 2014
Status
Member
Last seen
December 26, 2014
-
 rjbuer -
Hello,

1 spreadsheet has 15 columns of data with column A having the unique identifier

2 spreadsheet has 37 columns of data with column B having the same unique identifiers.

I want the matching unique identifiers of spreadsheet 1 and spreadsheet 2 to have the rows along with the header copied over into a new workbook. Can anybody help me? I would past my spreadsheet data so there were examples but not sure how.

Thank you very much in advance.

7 replies

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
post SMALL extract of sheet 1 and 2 and explain use speedyshare.com of uploading the file

not clear exactly what you want. for e.g. "a" is identifier in sheet 1 and shee2

which rows are to be copied - of sheet 1 and sheet 2
should those rows be copied in a sheet called that identifier in new workbook. that means new workbook will have so many sheets as unique identifiers.

one way of doing is to autofilter data and copy filtered data in respective sheet.
remove filter and again filter for second identifier etc.
Here is a sample of the data:

http://speedy.sh/aQEwb/sample-data.xlsb

What I need is all the unique rows found in column A copied over into a new workbook along with the corresponding rows for the unique identifier in column B of the second worksheet of the sample file. So for example all PB Admin values in column A of the first worksheet would have it's own new workbook that looked like this.

http://speedy.sh/QWeTp/Result.xlsx
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
I went through the files. It is possible to write a macro. I do not know whether you have already manipulated the sheets or not. there is mention of "filter" in row no.2 in the second sheet.
2. another discrepancy is sheet 1 starts in a2 sheet 2 starts in A5. it should be uniform for writing an easy macro

3. you have not intimated which column is having the identifier. I presume it is col. A in both the sheets

4. you saved the file as binary file . it gives me trouble. the file should be saved in xlsx or xlsm format and uploaded to speedy share

5. it is first not necessary to upload such a large file. if the identifier column is A it is enough four or five columns in both the sheets is saved in another file .xlsx or xlsm and uploaded.

i have already started working on the macro and these problems arose

please send a neat file.
Posts
2
Registration date
Tuesday December 23, 2014
Status
Member
Last seen
December 26, 2014

http://speedy.sh/PgDkD/sample-data.xlsx

The sheets now both have the identifier in column A. The data starts in column A1 of both files. Let me know if there is any questions.

Thank you again.
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
I managed to rig up a macro for you.
there is a macro "test" and a function for this macro.
you need only to run "test"

now you are thinking of different workbooks(that means files) for each identifier for each of the two sheet in the main file. I have put a letter Z at the beginning of the main file (where macro is located) to distinguish it easily form other files the macro will be created(in the same folder as the main file). You are creating nearly 30 files and copying the relevant data. so the running of macro may take some time I think about 30 seconds. If you want to DELETE all these created files only you have to run the macro "delete files". for safety you save the main file along with macros in some other locations also so that the file can be retrieved if there is some mess up


download the file (the macro is in vb editor) from

http://speedy.sh/ayGTb/Z-sample-data-MACRO-ENABLED.xlsm
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
there is some minor mistake in the macro test. I have corrected it and called it
macro_corrected. run this macro instead of "test". Just copy paste this SAME module

Sub test_corrected()
Dim mysh As Worksheet, r As Range, rfilt As Range, rB As Range
Dim j As Integer, unq As Range, cunq As Range, myshname As String
Dim ppath As String, filename As String
Dim identifier As String
Application.DisplayAlerts = False

ppath = ThisWorkbook.Path

' MsgBox ppath

For j = 1 To 2
Set mysh = Worksheets(j)

With mysh
Range(.Range("A1").End(xlDown).Offset(1, 0), .Cells(Rows.Count, "A")).EntireRow.Cells.Clear
.AutoFilterMode = False
myshname = mysh.Name
Set r = .Range("a1").CurrentRegion
Set rB = r.Columns("A:A")
Set unq = .Range("A1").End(xlDown).Offset(5, 0)
rB.AdvancedFilter xlFilterCopy, , unq, True
Set unq = Range(unq.Offset(1, 0), unq.End(xlDown))
End With 'mysh
For Each cunq In unq
identifier = Left(cunq, InStr(cunq, " "))
' MsgBox identifier

If Not FileExists(ppath & "\" & cunq.Value & ".xlsx") Then
'MsgBox "The file doesn't exist!"
GoTo nextstep
Else
Workbooks.Open ppath & "\" & cunq.Value & ".xlsx"
GoTo secondstep
End If
nextstep:
Workbooks.Add

With ActiveWorkbook
.SaveAs filename:=ppath & "\" & cunq & ".xlsx"
' MsgBox ActiveWorkbook.Name
.Worksheets(1).Name = identifier & " " & "to Mgr"
.Worksheets(2).Name = identifier & " " & "Res Calc"
End With
secondstep:
'filename = cunq.Value
r.AutoFilter field:=1, Criteria1:=cunq
Set rfilt = r.SpecialCells(xlCellTypeVisible)
rfilt.Copy

With Workbooks(cunq & ".xlsx") 'With Windows(cunq)

With .Worksheets(j)
.Range("a1").PasteSpecial
End With
.Save
.Close
End With
Next cunq

'===================
With ThisWorkbook.Worksheets(j)
Range(.Range("A1").End(xlDown).Offset(1, 0), .Cells(Rows.Count, "A")).EntireRow.Cells.Clear
.AutoFilterMode = False
End With
Next j
Application.DisplayAlerts = True
MsgBox "macro over new workbooks opened in the same folder check"
End Sub




'http://www.exceltip.com/files-workbook-and-worksheets-in-vba/determine-if-a-workbook-exists-using-vba-in-microsoft-excel.html

Function FileExists(FullFileName As String) As Boolean
' returns TRUE if the file exists
FileExists = Len(Dir(FullFileName)) > 0
End Function



'as thisworkbook is an xlsm file and all other files are xlsx
'used right(filename,1)=x as criterion to delete files
'http://mariaevert.dk/vba/?p=58
Sub deleteFiles()
Dim myPath, myfolder, fldr, fso, filename
myfolder = ThisWorkbook.Path
Set fso = CreateObject("Scripting.FileSystemObject") ' Get a File object to query.
Set fldr = fso.GetFolder(myfolder)

For Each filename In fldr.Files
If Right(filename, 1) = "x" Then

'MsgBox filename
End If
On Error Resume Next
filename.Delete True ' delete all files
Next
End Sub

It works, I appreciate your help.