VBA CODE. Button to browse and copy files into a workbook.

[mergim]

Hello there,

I am trying to make a button that opens up the browser where I then can load an excel file, which then copies the data from the loaded file. The data I want to copy is marked in yellow on picture one. Here the range is A5:F16, however that sometimes changes, so I need some sort of a dynamic range.copy. Maybe you could say something like copy range from where a cell value in column a is = 1.currentregion, in this case cell A5.
The number of rows can vary, so I need some sort of code that copies the last line, in this case to F16. I also want the button to be able to load files endless times. Lets say I have loaded one file, which goes from A5:F16. The second time I load a file, it needs to start from the next empty row which, in this case, would be row A17.
The last thing that I hope is possible, is to add the text after "Design id.:", which in this case is "12345-12345-12345" (see A1) to the amount of rows there are, in this case from A5 to F17, so 12 rows on the left of "Process no" in column A.

I hope this makes sense and is possible.

Thanks in advance,

 

[RobP]

great - thanks for your feedback.

 

[mergim]

Hello Rob,

I also forgot to mention another issue I might interfer with.
With regards to the splitting the RM number and revision (see picture). My code tells to split the RM number after the first 8 digits, so we have the RM number in one column and the rev. in another. Right now, the code is only looking at the first 8 digits.
However, as you see, sometimes the RM number can be 9 digits, and then it does not copy the correct value. Is there a way to tell the code to split the number, so every digit before the "dot / ." should go into one column(in this case column E), and every digit after the "dot / ." should go into another (column F).

For x = intlastrow + 1 To intlastrow + newdatarows
        If Len(CStr(Cells(x, 5))) > 8 Then
            Cells(x, 6) = Mid(Cells(x, 5), 10)
            Cells(x, 5) = Left(Cells(x, 5), 8)
        End If
    Next x
    
    Set master_array = Nothing  'clean memory

 

[mergim]

Hello Rob,

I also forgot to mention another issue I might interfer with.
With regards to the splitting the RM number and revision (see picture). My code tells to split the RM number after the first 8 digits, so we have the RM number in one column and the rev. in another. Right now, the code is only looking at the first 8 digits.
However, as you see, sometimes the RM number can be 9 digits, and then it does not copy the correct value. Is there a way to tell the code to split the number, so every digit before the "dot / ." should go into one column(in this case column E), and every digit after the "dot / ." should go into another (column F).

For x = intlastrow + 1 To intlastrow + newdatarows
        If Len(CStr(Cells(x, 5))) > 8 Then
            Cells(x, 6) = Mid(Cells(x, 5), 10)
            Cells(x, 5) = Left(Cells(x, 5), 8)
        End If
    Next x
   
    Set master_array = Nothing  'clean memory

View attachment 70830

Sometimes it can also be a comma ","

 

[RobP]

Hi Mergrim,

see if this can help :

I am working on the basis that your code will have a "." or a "," in it, so I add them together in split_point on the basis it will be one or other..

For x = intlastrow + 1 To intlastrow + newdatarows
        If Len(CStr(Cells(x, 5))) > 8 Then
                split_point = InStr(Cells(x, 5), ".") + InStr(Cells(x, 5), ",")
            
                Cells(x, 6) = Mid(Cells(x, 5), split_point + 1)
                Cells(x, 5) = Mid(Cells(x, 5), 1, split_point - 1)
           
        End If
    Next x
    
    Set master_array = Nothing  'clean memory

 

[mergim]

Hi Mergrim,

see if this can help :

I am working on the basis that your code will have a "." or a "," in it, so I add them together in split_point on the basis it will be one or other..

For x = intlastrow + 1 To intlastrow + newdatarows
        If Len(CStr(Cells(x, 5))) > 8 Then
                split_point = InStr(Cells(x, 5), ".") + InStr(Cells(x, 5), ",")
           
                Cells(x, 6) = Mid(Cells(x, 5), split_point + 1)
                Cells(x, 5) = Mid(Cells(x, 5), 1, split_point - 1)
          
        End If
    Next x
   
    Set master_array = Nothing  'clean memory

It worked!, thanks once again!

 

[mergim]

Hi Mergim,

this subroutine should do what you need, based on the info you provided. You can see your filename, and sheetnames coded below, so you will need to correct if they are different. It also assumes this file is in the same subdirectory as your main, else you need to add a full pathname.

Sub project_overview(design_id)

    Dim projectlastrow As Long
   
    Workbooks.Open ("Pipe overview.xlsx")
    bookname = ActiveWorkbook.Name
   
       projectlastrow = ActiveWorkbook.Worksheets("Project overview").Cells(Rows.Count, 2).End(xlUp).Row ' find the last row of data in the datafile
       ActiveWorkbook.Worksheets("Project overview").Range(Cells(projectlastrow + 1, 2), Cells(projectlastrow + 1, 2)) = design_id 'store design_id in Col. 2 ("B") starting row 2
   
    Workbooks(bookname).Save ' save the file with new data just added
    Workbooks(bookname).Close   'close the data file without any warning msgs..

End Sub

To call the subroutine from the main code, just insert the following line below where the previous file was closed (I added those lines below to highlight where to put it). The code should look like this

 ' close the datafile now we've used its data
    Workbooks(bookname).Saved = True 'make it think its saved already to avoid warning popup.
    Workbooks(bookname).Close   'close the data file without any warning msgs..
   
    '******** subroutine to store design_id number into seperate project overview file *********************
    project_overview (design_id)
   
    '******** Store Data to main file below *********************************
    intlastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'find the last row of data in the main file

Hello Rob.

I am not sure where to add the coding. Right now it looks like this;

Sub Load_Design()

Dim intlastrow, datalastrow, datafirstrow, newdatarows As Integer
Dim master_array As Variant
Dim design_id As String
Dim my_message As String
Dim rngPF As Range
Dim rngLA As Range
Dim rngTL As Range
Dim rngMP As Range
Dim rngDM As Range
Dim rngSP As Range
Dim rngSC As Range

Dim sht As Worksheet
Dim LastRow As Long

my_message = "Import Data to this workbook .."

ControlFile = ThisWorkbook.Name

On Error GoTo FileOpenErrorHandler: 'goto error handler (see at the end of the Sub)

NewFN = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:=my_message)
If NewFN = False Then
    ' User pressed Cancel
    Exit Sub
Else
    Workbooks.Open (NewFN)
    bookname = ActiveWorkbook.Name
        
    '**** Search for the first row of data in the datafile (bookname) thats been opened *****
    '*  first row of data in datafile in column A will contain a "1", so we search for that *
    
    For x = 1 To 20  ' set to 20, as if not found in first 20 rows, theres probably an issue somewhere
        If Cells(x, 1) = 1 Or Cells(x, 1) = "1" Then 'look for the first "1" in column A
            datafirstrow = x
            Exit For
        End If
    Next x
    If x = 20 Then
        MsgBox ("Data not found")
        Exit Sub
    End If
          
    '****************************************************************************************
               
        datalastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row ' find the last row of data in the datafile
        newdatarows = datalastrow - datafirstrow + 1
        design_id = Mid(ActiveSheet.Cells(1, 1).Text, 13) 'obtain the Design_id number from "A1"
        
        master_array = Range(Cells(datafirstrow, 1), Cells(datalastrow, 6)) 'grab all the data into master_array storage
               
    ' close the datafile now we've used its data
    Workbooks(bookname).Saved = True 'make it think its saved already to avoid warning popup.
    Workbooks(bookname).Close   'close the data file without any warning msgs..
    
    'Store Data to main file below
    intlastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'find the last row of data in the main file
    If intlastrow < 3 Then intlastrow = 1  'if no data in file, data will start from row 3 to allow first 2 rows of Header Titles
    ActiveSheet.Range(Cells(intlastrow + 1, 2), Cells(intlastrow + newdatarows, 6)) = master_array   'dump the data onto the main sheet
    
    Range(Cells(intlastrow + 1, 5), Cells(intlastrow + newdatarows, 6)).Select
    Selection.Cut Destination:=Range(Cells(intlastrow + 1, 8), Cells(intlastrow + newdatarows, 9))
    Range(Cells(intlastrow + 1, 3), Cells(intlastrow + newdatarows, 4)).Select
    Selection.Cut Destination:=Range(Cells(intlastrow + 1, 4), Cells(intlastrow + newdatarows, 5))
    
    'store design id in column A
    ActiveSheet.Range(Cells(intlastrow + 1, 1), Cells(intlastrow + newdatarows, 1)) = design_id
    
    'split the RM  Revision number if there is 9 chars or more ie. a rev. no on the end of it
            
    For x = intlastrow + 1 To intlastrow + newdatarows
        If Len(CStr(Cells(x, 5))) > 8 Then
                split_point = InStr(Cells(x, 5), ".") + InStr(Cells(x, 5), ",")
            
                Cells(x, 6) = Mid(Cells(x, 5), split_point + 1)
                Cells(x, 5) = Mid(Cells(x, 5), 1, split_point - 1)
            
        End If
    Next x
    
    
    Set master_array = Nothing  'clean memory
    
End If


Set sht = ThisWorkbook.Sheets("Pipe designs")   ' or Thisworkbook.Sheets(1)
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row   'Finds lastrow for column A,update to whichever one you need

Set rngPF = Range("G2:G" & LastRow)       'Updating column C with formula, change to what you nee
rngPF.Formula = "=IF(VLOOKUP(RC[-2],Database!C1:C5,4,FALSE)=0,""-"",VLOOKUP(RC[-2],Database!C1:C5,4,FALSE))"
    Range("G2").Select

Set rngLA = Range("C2:C" & LastRow)
rngLA.Formula = "=VLOOKUP(RC[-1],Database!R1C10:R8C11,2,FALSE)"

Set rngTL = Range("J2:J" & LastRow)
rngTL.Formula = "=XLOOKUP(RC[-9],'Project overview'!C2,'Project overview'!C7)"

Set rngMP = Range("K2:K" & LastRow)
rngMP.Formula = "=RC[-3]+RC[-2]*RC[-3]/100"

Set rngSP = Range("M2:L" & LastRow)
rngSP.Formula = "=VLOOKUP(RC[-8],Database!C1:C5,5,FALSE)"

Set rngDM = Range("L2:L" & LastRow)
rngDM.Formula = "=RC[-2]*RC[-1]"


Set rngSC = Range("N2:N" & LastRow)
rngSC.Formula = "=XLOOKUP(RC[-13],'Project overview'!C2,'Project overview'!C1,)"

Exit Sub 'exit sub preventing to run the error handler (if success)

FileOpenErrorHandler:
    MsgBox "Error while opening " & NewFN & vbNewLine & "Something is wrong with this file. To solve the problem, open the file, save it, and then reload"


End Sub

 

[RobP]

Hi,
the sub project_overview(design_id) chunk of code is placed as a seperate Subroutine AFTER your main code. Then means it all goes after your "End Sub" (your last line of code) .

Then, as you can see from my description you add just one line of code into your main code to call it.

So look for the lines in your main code that show :
Workbooks(bookname).Saved = True 'make it think its saved already to avoid warning popup.
Workbooks(bookname).Close 'close the data file without any warning msgs..

Then ADD just this line below it.

'******** subroutine to store design_id number into seperate project overview file *********************
project_overview (design_id)

Rgds
Rob

 

[mergim]

Hi,
the sub project_overview(design_id) chunk of code is placed as a seperate Subroutine AFTER your main code. Then means it all goes after your "End Sub" (your last line of code) .

Then, as you can see from my description you add just one line of code into your main code to call it.

So look for the lines in your main code that show :
Workbooks(bookname).Saved = True 'make it think its saved already to avoid warning popup.
Workbooks(bookname).Close 'close the data file without any warning msgs..

Then ADD just this line below it.

'******** subroutine to store design_id number into seperate project overview file *********************
project_overview (design_id)

Rgds
Rob

Hello Rob.

I think I may have find the issue.
I see that you have put the filename to be ""Pipe overview". This is not dynamic. The code should do the same as the other coding - you load a file, get the design-id and put it the first empty row in column b, starting from 2nd row in sheet "Project overview". Right now the coding is not dynamic, as it is locked to one filename, which is "Pipe overview". I want to do it exactly like the first code, where you load the file, and it is copied into column, where the filename is just the one you load I hope this makes sense.