Hello All,
I have a button where by pressing it, it will import some data. In this button, I have a formula written in VBA format, which you also see below
. As you can see this formula applies to all rows in column from J2:J whether there is a value or not. What I want to do is to have the coding only apply to the next empty row. The problem with the current formula is, lets say that I have loaded some data, and I do some manual changes. The next time I load again (by pressing the button), the values that I manually put in will be overwritten by the coding, as the formula applies to all rows. I hope it makes sense
I have a button where by pressing it, it will import some data. In this button, I have a formula written in VBA format, which you also see below
VBA Code:
Set rngTL = Range("J2:J" & LastRow)
rngTL.Formula = "=XLOOKUP(RC[-9],'Project overview'!C2,'Project overview'!C8)"
VBA Code:
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 rngStock As Range
Dim sht As Worksheet
Dim LastRow As Long
Dim TF As Range
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'!C8)"
Set rngMP = Range("K2:K" & LastRow)
rngMP.Formula = "=RC[-3]+RC[-2]*RC[-3]/100"
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,)"
Set rngSP = Range("M2:M" & LastRow)
rngSP.Formula = "=IF(XLOOKUP(RC[-12],'Project overview'!C2,'Project overview'!C9)=""Static"",(XLOOKUP('Pipe designs'!RC[-8],Database!C1,Database!C[-8])),(XLOOKUP('Pipe designs'!RC[-8],Database!C1,Database!C6)))"
Set rngStock = Range("P2:P" & LastRow)
rngStock.Formula = "=SUMIFS('617 - 1 Stock Requirements Total.xlsx'!C7,'617 - 1 Stock Requirements Total.xlsx'!C2,XLOOKUP(RC[-11],Database!C1,Database!C8),'617 - 1 Stock Requirements Total.xlsx'!C12,""KAL-PLAN"")"
Set TF = Range("Q2:Q" & LastRow)
TF.Formula = "=AND(XLOOKUP(RC[-12],Database!C1,Database!C2)=""TENSILE"",'Pipe designs'!RC[-8]<25)"
On Error Resume Next
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
