Run a macro inside another macro

Paulandreaoc · Apr 26th 2020

I am working in a project, what I have to do is let the user choose multiple excel files and then from every single file run a macro that take the information in some specific cells of the files and put that information in a new excel file, all the information that I need have to be in the same sheet of the new excel file.

Right now I have two macros that works separated: one for choose and open the excel files and another one to run the macro that take the information, but I need to unified these two and make them just one code. If someone can help me I really appreciate it.

First macro:

Code

Sub Consolidate_Data()


Dim wb As Workbook
Dim sh As Worksheet


Dim dsh As Worksheet
Set dsh = ThisWorkbook.Sheets("Sheet1")


dsh.UsedRange.Clear


Dim File_Name As Variant


File_Name = Application.GetOpenFilename("Excel Files (*.xl*),*.xl*", , "Select Excel Files To Consolidate", , True)


Dim i As Integer


Dim lr As Long


For i = LBound(File_Name) To UBound(File_Name)


lr = dsh.Range("A" & Application.Rows.Count).End(xlUp).Row


Set wb = Workbooks.Open(File_Name(i))
Set sh = wb.Sheets(1)


sh.UsedRange.Copy dsh.Range("A" & lr + 1)


wb.Close False


Next i




End Sub

Display More

Second Macro:

Code

Sub ExtraerValores()
Dim i As Long
Dim BuscarHoja As Boolean
On Error Resume Next


BuscarHoja = (Worksheets("ExtractedData").Name <> "")
If BuscarHoja = False Then
Sheets.Add before:=Sheets(1)
End If


ActiveSheet.Name = "ExtractedData"


Sheets("ExtractedData").Activate


Sheets("ExtractedData").Cells.Select


Selection.ClearContents




Sheets("ExtractedData").Range("A1") = "Classification"
Sheets("ExtractedData").Range("B1") = "Inspector"
Sheets("ExtractedData").Range("C1") = "Standard"
Sheets("ExtractedData").Range("D1") = "Requirement"
Sheets("ExtractedData").Range("E1") = "Classification Rilievi"




v = 5
d = 2
l = 11
m = 6
n = 6
r = 6
Do While v < 550


If Worksheets("report stampabile").Range("P" & v) = "OSS" Or "NC" Or "COM" Then
Sheets("ExtractedData").Range("A" & d) = Sheets("report stampabile").Range("P" & v)
Sheets("ExtractedData").Range("B" & d) = Sheets("report stampabile").Range("D" & l)
Sheets("ExtractedData").Range("C" & d) = Sheets("report stampabile").Range("C" & m)
Sheets("ExtractedData").Range("D" & d) = Sheets("report stampabile").Range("G" & n)
If Worksheets(Sheets(r)).Range("P5") = "OSS" Or "NC" Or "COM" Then
Sheets("ExtractedData").Range("E" & d) = Sheets(r).Range("P5")
r = r + 1
If Worksheets("ExtractedData").Range("E" & d) = 0 Then
Sheets("ExtractedData").Range("E" & d) = ""
End If
v = v + 10
d = d + 1
l = l + 10
m = m + 10
n = n + 10


End If
End If
Loop
End Sub

Display More

Mumps · Apr 26th 2020

Your first macro opens one or more workbooks and copies the used range of Sheet1 from each workbook to Sheet1 of the workbook containing the macros. The second macro processes some data using two worksheets, "ExtractedData" and "report stampabile". I can't see how the two macros are related. I think that it would be easier to help and test possible solutions if you could attach a copy of the file containing the macros and a copy of one or two files that are being opened. Explain in detail what you want to do referring to specific cells, rows, columns, sheets and workbooks using a few examples from your data (de-sensitized if necessary).

**royUK** · Apr 26th 2020

Paul

Welcome to Ozgrid.

Please take a few minutes to read our Forum Rules to see why and how I have added Code Tags to your post.

Paulandreaoc · Apr 26th 2020

Both macros are related because each of the open worbooks have to run the macro 2, I can attach two of the open files I have to analize.

What I want to do is create a Macro that when I run it let me choose multiple files and for each file copy the information I want in a new excel file

Mumps · Apr 26th 2020

Sheet1 in the opened files is "ExtractedData". Do you want to run macro 2 on each opened file before the "ExtractedData" sheet (Sheet1) is copied to the workbook containing the macro?

Paulandreaoc · Apr 26th 2020

What I want is that the big macro (macro 1 and 2 working together) creates the sheet call "extracted data" in a new excel file, for that first we have to choose the files that I need to open and then run the macro 2 in each of them and finally creates a sheet1 "ExtractedFData" in that new open file with the information that I have extracted with macro 2.

Mumps · Apr 26th 2020

Working on it. I'll get back to you as soon as I can.

Mumps · Apr 26th 2020

Code

If Worksheets(Sheets(r)).Range("P5") = "OSS" Or "NC" Or "COM" Then

In this line of code, r is set to start at 6 so Sheets(r) would be Sheets(6). Would this be the first "Rilievo" sheet? If so, the first "Rilievo" sheet would be Sheets(5) not Sheets(6). Does this make sense?

Paulandreaoc · Apr 26th 2020

the idea is analyze all the Rilievos independent on the sheet they are in, because in one file I can have 8 rilievos but in other one I can have maybe 10 or 2

Mumps · Apr 26th 2020

OK. I'm doing some major revisions on the macros, so I'll get back to you as soon as I can.

Mumps · Apr 26th 2020

Try:

Code

Sub Consolidate_Data()
    Application.ScreenUpdating = False
    Dim wb As Workbook, sh As Worksheet, dsh As Worksheet, File_Name As Variant, i As Long, lr As Long, x As Long
    Dim desWS As Worksheet, srcWS As Worksheet, r As Long: r = 6
    Set dsh = ThisWorkbook.Sheets("Sheet1")
    dsh.UsedRange.ClearContents
    File_Name = Application.GetOpenFilename("Excel Files (*.xl*),*.xl*", , "Select Excel Files To Consolidate", , True)
    For i = LBound(File_Name) To UBound(File_Name)
        Set wb = Workbooks.Open(File_Name(i))
        If Not Evaluate("isref('" & "ExtractedData" & "'!A1)") Then
           Sheets.Add before:=Sheets(1)
           ActiveSheet.Name = "ExtractedData"
           Range("A1").Resize(, 5) = Array("Classification", "Inspector", "Standard", "Requirement", "Classification Rilievi")
           Columns.AutoFit
        Else
            Sheets("ExtractedData").UsedRange.Offset(1).ClearContents
        End If
        Set desWS = Sheets("ExtractedData")
        Set srcWS = Sheets("report stampabile")
        lr = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For x = 5 To lr Step 10
            Select Case srcWS.Range("P" & x).Value
                Case "NC", "OSS", "COM"
                    With desWS
                        .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(srcWS.Range("P" & x), srcWS.Range("P" & x).Offset(6, -12), srcWS.Range("P" & x).Offset(1, -13), srcWS.Range("P" & x).Offset(1, -9))
                        With Sheets(r)
                            Select Case .Range("P5").Value
                                Case "OSS", "NC", "COM"
                                    desWS.Cells(desWS.Rows.Count, "E").End(xlUp).Offset(1) = Sheets(r).Range("P5")
                                    r = r + 1
                                    If desWS.Cells(desWS.Rows.Count, "E").End(xlUp) = 0 Then
                                        desWS.Cells(desWS.Rows.Count, "E").End(xlUp) = ""
                                    End If
                            End Select
                        End With
                    End With
            End Select
        Next x
        With desWS
            .Columns.AutoFit
            .UsedRange.Copy dsh.Cells(dsh.Rows.Count, "A").End(xlUp).Offset(1)
        End With
        wb.Close False
        r = 6
    Next i
    With dsh
        .Rows(1).Delete
        .Columns.AutoFit
    End With
    Application.ScreenUpdating = True
End Sub

Display More

Paulandreaoc · Apr 26th 2020

It did not work, there is not any error, I just did not receive anything in Sheet1.

Maybe is better eliminate the "extracted data sheet" in the files that I choose to open and work with this kind of files, and create the "Extracted Data" in the new excel file.

Mumps · Apr 26th 2020

Place the macro in a new, blank workbook and run it from there. I tested it with the 2 files you posted and it worked exactly as your requested.

Paulandreaoc · Apr 26th 2020

It did not work to me, but I appreciate your help

thank you so much

Mumps · Apr 26th 2020

The attached file shows the results of the macro using the 2 files you posted. Try it by clearing all the data in Sheet1 and then run the macro in Module1.

Paulandreaoc · Apr 26th 2020

you are right, thank you so much for your help.

Mumps · Apr 27th 2020

You are very welcome.

Paulandreaoc · Apr 29th 2020

Hi Mumps, I am trying to add some information to the code you gave me and I am a little confuse, maybe you can help me this time too:

1. I would like to add a column (in column A) calls "Laboratory" that extracts the information of cell P2 of the "report stampabile"

2. To add a column (in column B) calls "Evaluation Date" that extracts the infomation of cell I3 from "report stampabile"

3. To add a column (in column C) calls "Technical Functionary" that extract the informationof cell E18 from "Rilievo 1"

4. To add a column (in column F) calls "Inspector 2" that extract the information of d14,d24,d34 etc from "report stampabile"

I hope you can help me, thank you

Mumps · Apr 30th 2020

In your source files you have many ranges with merged cells. You should not use merged cells because they almost always create problems for Excel macros. In the first macro I suggested, the merged cells were not causing any problems but in the revised macro below, they are causing problems. In all of your source files, you will have to unmerge the cells in columns P:S to the right of all occurrences of the text "Firma Direzione Tecnica" before you run the new macro. Make sure you unmerge the cells in the columns and the 2 rows.

Code

Sub Consolidate_Data()
    Application.ScreenUpdating = False
    Dim wb As Workbook, sh As Worksheet, dsh As Worksheet, File_Name As Variant, i As Long, lr As Long, x As Long, y As Long
    Dim desWS As Worksheet, srcWS As Worksheet, r As Long: r = 6
    Set dsh = ThisWorkbook.Sheets("Sheet1")
    dsh.UsedRange.ClearContents
    File_Name = Application.GetOpenFilename("Excel Files (*.xl*),*.xl*", , "Select Excel Files To Consolidate", , True)
    For i = LBound(File_Name) To UBound(File_Name)
        y = 2
        Set wb = Workbooks.Open(File_Name(i))
        If Not Evaluate("isref('" & "ExtractedData" & "'!A1)") Then
            Sheets.Add before:=Sheets(1)
            With ActiveSheet
                .Name = "ExtractedData"
                .Range("A1").Resize(, 9) = Array("Laboratory", "Evaluation Date", "Technical Functionary", "Classification", "Inspector", "Inspector 2", "Standard", "Requirement", "Classification Rilievi")
            End With
            Columns.AutoFit
        Else
            With ActiveSheet
                .UsedRange.Offset(1).ClearContents
                .Range("A1").Resize(, 9) = Array("Laboratory", "Evaluation Date", "Technical Functionary", "Classification", "Inspector", "Inspector 2", "Standard", "Requirement", "Classification Rilievi")
            End With
        End If
        Set desWS = ActiveWorkbook.Sheets("ExtractedData")
        Set srcWS = ActiveWorkbook.Sheets("report stampabile")
        lr = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For x = 5 To lr Step 10
            Select Case srcWS.Range("P" & x).Value
                Case "NC", "OSS", "COM"
                    With desWS
                        .Cells(y, "A").Resize(, 2).Value = _
                            Array(srcWS.Range("P" & x).Offset(-3), srcWS.Range("P" & x).Offset(-2, -7)) ', srcWS.Range("P" & x), srcWS.Range("P" & x).Offset(6, -12), srcWS.Range("P" & x).Offset(1, -13)) ', srcWS.Range("P" & x).Offset(1, -9))
                        .Cells(y, "D").Resize(, 2).Value = _
                            Array(srcWS.Range("P" & x), srcWS.Range("P" & x).Offset(6, -12))
                        .Cells(y, "F").Resize(, 3).Value = _
                            Array(srcWS.Range("P" & x).Offset(9, -12), srcWS.Range("P" & x).Offset(1, -13), srcWS.Range("P" & x).Offset(1, -9))
                        With ActiveWorkbook.Sheets(r)
                            Select Case .Range("P5").Value
                                Case "OSS", "NC", "COM"
                                    desWS.Cells(y, "C") = Sheets(r).Range("E18")
                                    desWS.Cells(y, "I") = Sheets(r).Range("P5")
                                    r = r + 1
                                    If desWS.Cells(y, "I") = 0 Then
                                        desWS.Cells(y, "I") = ""
                                    End If
                            End Select
                        End With
                        y = y + 1
                    End With
            End Select
        Next x
        With desWS
            .Columns.AutoFit
            .UsedRange.Copy dsh.Cells(dsh.Rows.Count, "A").End(xlUp).Offset(1)
        End With
        wb.Close False
        r = 6
    Next i
    With dsh
        .Rows(1).Delete
        .Columns.AutoFit
    End With
    Application.ScreenUpdating = True
End Sub

Display More

Paulandreaoc · Apr 30th 2020

I did it and it did not work, maybe do you have the excel file with the macro?

Run a macro inside another macro

Participate now!

Share