I am trying to write a code that will take column B and increment the values in the column by a value that can be entered into an input message box by the user. In the example provided below the user wants 0.1 as his or her increment for column B. Column A should be linearly interpolated as column B is shortened.
So far my code is just set up to grab data from the specified machine and bring it into the sheet where the raw data will be cleaned into usable data. I’ve been researching for days and can’t quite get my head around how to set the increment and interpolate the data.
Raw data looks similar to this but much larger. There is a lot of data missing here. One of the files has nearly 13000 rows. A completely parsed file will have less than 400 rows.
A B
<tbody>
</tbody>
Cleaned data should look something like this:
A B
<tbody>
</tbody>
My code so far. This is basically just moving files from the file location to the target sheet and creating new tabs, naming tabs, etc. Some of the dims are not used yet as I’ve just been trying different things to make my code work.
Thanks in advance for any help. All suggestions are much appreciated.
Best,
Brandon
So far my code is just set up to grab data from the specified machine and bring it into the sheet where the raw data will be cleaned into usable data. I’ve been researching for days and can’t quite get my head around how to set the increment and interpolate the data.
Raw data looks similar to this but much larger. There is a lot of data missing here. One of the files has nearly 13000 rows. A completely parsed file will have less than 400 rows.
A B
| 0.00 | 0.01 |
| 0.00 | 0.01 |
| 0.00 | 0.01 |
| 0.00 | 0.01 |
| 0.00 | 0.01 |
| 0.00 | 0.02 |
| 0.00 | 0.02 |
| 0.00 | 0.02 |
| 0.00 | 0.03 |
| 0.17 | 0.03 |
| 0.17 | 0.03 |
| 0.17 | 0.04 |
| 0.34 | 0.04 |
| 0.17 | 0.05 |
| 0.17 | 0.05 |
| 0.34 | 0.06 |
| 0.34 | 0.07 |
| 0.51 | 0.07 |
| 0.51 | 0.07 |
| 0.51 | 0.08 |
| 0.68 | 0.09 |
| 0.68 | 0.10 |
| 0.68 | 0.10 |
| 0.84 | 0.11 |
| 0.84 | 0.12 |
| 0.84 | 0.12 |
<tbody>
</tbody>
Cleaned data should look something like this:
A B
| 0.1 | 0.527421817 |
| 0.2 | 0.991580884 |
| 0.3 | 1.586479186 |
| 0.4 | 2.314630901 |
| 0.5 | 2.835397098 |
| 0.6 | 3.544292655 |
| 0.7 | 4.022441664 |
| 0.8 | 4.613159911 |
| 0.9 | 5.105284463 |
| 1 | 5.593649288 |
| 1.1 | 6.14812775 |
| 1.2 | 6.687576899 |
| 1.3 | 7.186948527 |
| 1.4 | 7.721394663 |
| 1.5 | 8.216697024 |
| 1.6 | 8.832567724 |
| 1.7 | 9.419757746 |
| 1.8 | 10.02798463 |
| 1.9 | 10.64584242 |
| 2 | 11.2516133 |
| 2.1 | 11.91266204 |
| 2.2 | 12.51039649 |
| 2.3 | 13.09953086 |
| 2.4 | 13.64477697 |
| 2.5 | 14.36453506 |
| 2.6 | 15.08429885 |
| 2.7 | 15.67496777 |
| 2.8 | 16.29622629 |
| 2.9 | 16.91370968 |
| 3 | 17.60455092 |
| 3.1 | 18.17145856 |
<tbody>
</tbody>
My code so far. This is basically just moving files from the file location to the target sheet and creating new tabs, naming tabs, etc. Some of the dims are not used yet as I’ve just been trying different things to make my code work.
Code:
Sub interpolate()
Dim i As Integer 'counter for raw data row count
Dim j As Integer 'counter for clean data column count
Dim k As Integer 'counter for raw data column count
Dim count As Integer
Dim Load(1 To 20000) As Variant
Dim Disp(1 To 20000) As Variant
Dim z1(1 To 20000) As Variant
Dim r
Dim DataFile As String
Dim DataName As String
Dim DataSheetName As String
Dim Message As String
Dim Title As String
Dim Default As String
Dim DataSheetVariant As Variant
Dim DataSheetNumber As Integer
Dim ProgramName As String
Dim WBf As Workbook
Dim WBt As Workbook
Dim DSA As Worksheet 'DSA=Data Set A
Dim fnameandpath As Variant
Dim path As String, filename As String, filetype As String
Dim SpacePos As Integer
Dim SV As Integer 'SV=Serial number Search Value
Dim Inc As Double 'deflection increment value
'**************TEST DATA LOCATION******************
ChDrive "U:\"
ChDir "U:\location"
fnameandpath = Application.GetOpenFilename()
If fnameandpath = False Then Exit Sub
'*************************************************
Set WBf = Workbooks.Open(fnameandpath)
Set WBt = ThisWorkbook
'Set RD = WBt.Sheets.Add(After:=Sheets(WBt.Sheets.Count))
'On Error GoTo User_Canceled:
'***************************
'Enter desired serial number and find in from file
'***************************
SV = InputBox("Please provide serial number.", "Serial Number")
'If SV = "" Then Exit Sub
Set found = Range("A1:FZ1").Find(What:=SV, LookIn:=xlValues, LookAt:=xlWhole)
If found Is Nothing Then
MsgBox "Serial number not found."
Else
'selects 4 columns and 16000 rows from serial number designation
found.Offset(0, 0).Resize(16000, 2).Copy
found.Offset(1, 0).Select
End If
'************************
'Copy Data from file
'************************
'With WBf
'Sheets("Raw Data").Select
'Range(Cells(1, 1), Cells(15000, 65)).Select
'Selection.Copy
'End With
'*********************
'return to target worksheet
'*********************
WBt.Activate
'create new worksheet
Set DSA = WBt.Sheets.Add(after:=WBt.Sheets(ThisWorkbook.Sheets.count))
DSA.Name = "Data Set A"
With WBt
ary = Split(fnameandpath, "\")
bry = Split(ary(UBound(ary)), ".")
ary(UBound(ary)) = ""
path = Join(ary, "\")
filename = bry(0)
filetype = bry(1)
End With
'*********************************
'Copying file name to new tab name
'*********************************
With RD
Range("A1") = "Path:"
Range("A2") = "Filename:"
'Range("A3") = "Filetype:"
Range("B1") = path
Range("B2") = filename
'Range("B3") = filetype
SpacePos = InStr(Range("B2"), " ") 'Looks for space in string
ActiveSheet.Name = Left(Range("B2"), SpacePos + 0) 'use everything to the left of the space and 14 char to the right
'***********************
'Paste Data into new Tab
'***********************
Range("A4").PasteSpecial xlPasteAll
End With
Application.DisplayAlerts = False
WBf.Close False
‘This is just my first attempts at figuring out a way to get the increment working. It’s all wrong.
'Inc = InputBox("Please specify deflection increment value.")
Range("B7") = ActiveCell
i = 7
j = 7
i = i + 1
test = (ActiveCell.Value) - ActiveCell.Offset(1, 0).Value < 0.001
Do While ActiveCell <> ""
If test = True Then
ActiveCell.Offset(1, 0).EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
'Do While ActiveCell <> ""
'User_Canceled:
End SubThanks in advance for any help. All suggestions are much appreciated.
Best,
Brandon
Last edited:
