PDA

View Full Version : [SOLVED] Find string in multiple rows



mattreingold
06-24-2019, 07:04 AM
Hello all,

I would first like to explain what I am trying to accomplish, in case my idea is not the best solution.

I have test data with the following format:


[Header1] [Header2]
Date/time Value
Date/time Value
. .
. .
... ...
DONE

Date/time Value
Date/time Value
. .
. .
... ...
DONE

Date/time...Value
.................
DONE



ESSENTIALLY what I have is an excel sheet with two columns, a header at the top for each, then date and time in col a, and the test value in col b, when a test is finished a button is pressed which stops data logging, marks 'DONE' at the last row of col a, skips a row then another test is run as seen above, then marked with done etc.

I am trying to write code to skip the header (for the first array of data), take col a and b into the first value of the 2 column array, then look for DONE as the end, skip a line after and grab the next set of data for the array whose end is marked with the next DONE - and continue this until there are no more tests ran (the workbook would just end with DONE in the a col, and no further data would follow.

What I was thinking of doing was to use .find to find all of the 'DONE's' and return their row locations and store it into an array. These row numbers would mark the end of each test, and I could use logic to march backwards to determine each tests starting row based on the previous (all hitching on the fact that the first test starts immediately after the header, on the second row).

Sorry if that is a lot to digest... I eventually need to plot the value against the time, and I can handle all the code from there, I am just looking for help/tips on how to grab the data from the format I am given (which comes from a text file in csv format, btw).

Thank you very much in advance,
Matt

xld
06-24-2019, 11:01 AM
Sub LoadArray()
Dim lastrow As Long
Dim i As Long
Dim mtx As Variant

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = lastrow To 2 Step -1

If .Cells(i, "A").Value = vbNullString Or _
.Cells(i, "A").Value = "DONE" Then

.Rows(i).Delete
End If
Next i


lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
mtx = .Range("A2").Resize(lastrow - 1, 2)
End With
End Sub

mattreingold
06-25-2019, 06:01 AM
Hello xld,

Thank you very much for your reply, I just got in for the morning so apologies for the delay in response.

I have a few things going on this morning, so I will be able to test this in a little bit.

Upon looking over your code, it appears that your code deletes empy rows or those that contain "DONE" then creates and resizes an array to store both cols a and b - looks good!

One discrepancy, I need separate arrays for each set of data between the "Done's", if you will.

Each group of rows between the DONE's are different tests, and I am looking to plot them separately. This is why I was looking to capture the row number of each "DONE" so that I could mark the ends of each of these arrays, and somehow capture each using that value.

I hope this makes sense, and I very much appreciate your help!

EDIT: Looking at my op I see I was a little unclear, apologies for the miscommunication!

Best,
Matt

xld
06-25-2019, 12:06 PM
Sub LoadArrays()
Dim rng As Range
Dim cell As Range
Dim firstAddress As String
Dim numArrays As Long
Dim idxArrays As Long
Dim firstrow As Long
Dim lastrow As Long
Dim i As Long
Dim aryOfRanges As Variant
Dim mtx As Variant

With ActiveSheet

numArrays = Application.CountIf(.Columns(1), "DONE")
ReDim aryOfRanges(1 To numArrays)
idxArrays = 1

firstrow = 2
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A2").Resize(lastrow - 1)

Set cell = Nothing
With .Columns(1)

Set cell = .Find(What:="DONE", _
After:=.Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not cell Is Nothing Then

firstAddress = cell.Address

Do

lastrow = cell.Row
aryOfRanges(idxArrays) = .Cells(firstrow, "A").Resize(lastrow - firstrow, 2)
firstrow = lastrow + 2
Set cell = .FindNext(cell.Offset(2, 0))
idxArrays = idxArrays + 1
Loop While Not cell Is Nothing And cell.Address <> firstAddress
End If
End With
End With
End Sub

mattreingold
06-25-2019, 01:04 PM
Xld, thank you. This is absolutely genius and just what I needed.

Thank you so much!

mattreingold
06-26-2019, 05:44 AM
Hello again,

I started testing with this code you provided, and it seems it throws an error on the last set of data/array.

first row is somewhere around 470,000 (around the end of the data set in this workbook) but for some reason lastrow is set to 1 when this error gets thrown.

I get a '1004 Application defined or object defined error'

Here is the code I was using:


Sub RunReport()


' Establish All Workbook and Worksheet Variables
Dim WBT As Workbook ' This Workbook
Dim WBD As Workbook ' Data Workbook
Dim WSD As Worksheet ' Data Sheet from data workbook
Dim WPN As Worksheet ' Report, in WBT


Set WBT = ThisWorkbook ' Sets 'WBT' equal to a workbook variable assigned to the seed file


' Variable assignment
Dim fso As New FileSystemObject ' Enables macro to search file explorer for files
Dim mtwFiles As Variant ' String that holds the file name


mtwFiles = Application.GetOpenFilename("mtwData Files (*.), *.mtwData)", 1, "Select Desired File.", "Select", False) ' Gets file name of clicked file


''''''''''''' Open Workbook with string name from mtwFiles string
dataWorkbookFileName = fso.GetFileName(mtwFiles) ' Gets filename of file
Workbooks.Open mtwFiles ' Opens the data Workbook




''''''''''''' Set workbook and worksheet variables
Set WBD = Workbooks(dataWorkbookFileName) ' 'WBD' gets set to the data workbook
Set WSD = WBD.Sheets(1) ' 'WSD' is the first sheet (the only sheet) in the data workbook
Set WPN = WBT.Sheets(1) ' 'WPN' is the first sheet (data table) in this report macro workbook


With WSD

numArrays = Application.CountIf(.Columns(1), "DONE")
ReDim aryOfRanges(1 To numArrays)
idxArrays = 1

firstrow = 2
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A2").Resize(lastrow - 1)
Set cell = Nothing
With .Columns(1)

Set cell = .Find(What:="DONE", _
After:=.Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not cell Is Nothing Then

firstAddress = cell.Address

Do

lastrow = cell.Row
aryOfRanges(idxArrays) = .Cells(firstrow, "A").Resize(lastrow - firstrow, 2)
firstrow = lastrow + 2
Set cell = .FindNext(cell.Offset(2, 0))
idxArrays = idxArrays + 1
Loop While Not cell Is Nothing And cell.Address <> firstAddress
End If
End With
End With
End Sub


Ive also attached the data workbook so that it is easier for you to see what is happening, it is too large to upload through here, so here is a download link: https://www.mediafire.com/file/3vd191usgz48aek/Combined_Data_1-102_RAW.xlsx/file

Also, I was looking over the code; does the 'aryOfRanges' store only the "A" column values? Or does it also store the "B" column values into a 2 col array? Optimally, it would be awesome if the "A" column values could be in one array, say 'dateTimeArray' and its corresponding data values, in this case it is depth in mm, could be in another, say 'depthArray'. I plan on then pasting these two arrays into a worksheet from which the macro runs for each sample, creating a sheet for each test (I have code for this already) - Im just struggling, again, in gathering the data from this log format into arrays to paste.

I also attached the macro workbook in case you were curious (the formatting of it wont really help, though - some of the reporting I have planned isnt written in the code attached above, but may give you a feel for what I'm going for).


Thanks a million, again.
Matt

24497

xld
06-26-2019, 11:27 AM
The problem is your data, it is not the consistent structure you painted. There are multiple instances of a DONE/empty pair of rows followed by another DONE/empty pair of rows. And there is not a final DONe at the end of the data.

xld
06-26-2019, 12:38 PM
Oh, yes, a heading of DONE causes problems too.

mattreingold
06-26-2019, 12:50 PM
Aha, you are very right. I cleaned up the workbook in regards to the extraneous "done's" and also I didnt catch the header being DONE, but fixed that as well and it runs beautifully.

The test is started and stopped with two buttons and often I hit the stop button twice to make sure it stopped fully, but it was programmed to mark done, hence the duplicates.

Thank you, very much, again xld.

Just one remaining question, if you will; does this grab the two columns into a 2 col array? Or just grab col a into a single col array?

I'd like cols and and b to have separate arrays, if possible.

You really are the best, I cant thank you enough for your attention!

Matt

xld
06-26-2019, 02:51 PM
You are right, it is a matrix, not a vector.

This code should load two vector arrays, and it also manages all of those data anomalies should they arise again


Sub LoadArrays()
Const BLOCK_END As String = "DONE"
Dim rng As Range
Dim cell As Range
Dim aryColA As Variant
Dim aryColB As Variant
Dim firstAddress As String
Dim numArrays As Long
Dim idxArrays As Long
Dim firstrow As Long
Dim lastrow As Long
Dim numrows As Long

With ActiveSheet

numArrays = Application.CountIf(.Columns(1), BLOCK_END)
ReDim aryColA(1 To numArrays)
ReDim aryColB(1 To numArrays)
idxArrays = 1

firstrow = 2
lastrow = .Cells(.Rows.Count, "A").End(xlUp).row
If .Cells(lastrow, "A").Value <> BLOCK_END Then

lastrow = lastrow + 1
.Cells(lastrow, "A").Value = BLOCK_END
End If
Set rng = .Range("A2").Resize(lastrow - 1)

Set cell = Nothing

Set cell = .Columns(1).Find(What:=BLOCK_END, _
After:=.Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not cell Is Nothing Then

firstAddress = cell.Address
Do

lastrow = cell.row
numrows = lastrow - firstrow
If numrows > 1 Then

aryColA(idxArrays) = .Cells(firstrow, "A").Resize(numrows)
aryColB(idxArrays) = .Cells(firstrow, "B").Resize(numrows)
idxArrays = idxArrays + 1
End If
firstrow = lastrow + 2
Set cell = .Columns(1).FindNext(cell.Offset(1, 0))
Loop While Not cell Is Nothing And cell.Address <> firstAddress And cell.row <> 1
End If
End With
End Sub

mattreingold
06-27-2019, 05:17 AM
Works absolutely perfectly. Thank you again for your time xld, I appreciate it very much - this will save me days if not weeks of data analysis!

Thanks Again!

Best,
Matt

mattreingold
06-27-2019, 06:06 AM
Alright xld, I feel like were in the home stretch lol.

I've got mostly everything working as I need, one exception.

I've gone ahead and wrote nearly the rest of the code for this workbook (see below) and the only remaining issue I have is pasting the arrays themselves.

I am making a sheet for each test, and pasting its values within that sheet. aryColA and aryColB get pasted into ranges "A48:A...." and "B48:B...." respectively.

When I run the macro on the data workbook provided, it seems to only paste the first value of the array repeatedly, not each value of the array.

I know the issue is with my lack of knowledge on how to manipulate the array structure.

Below is the code as well as the macro workbook and the data workbook, hopefully a small tweak and well be right there!

Link to data workbook: https://www.mediafire.com/file/null/Combined_Data_1-102_RAW.xlsx/file

EDIT: highlighted current array assignment so its easy to find, issue is with this range being the same, first value in the array


Sub RunReport()


' Sets screen to not update for faster execution
Application.ScreenUpdating = False


' Establish All Workbook and Worksheet Variables
Dim WBT As Workbook ' This Workbook
Dim WBD As Workbook ' Data Workbook
Dim WSD As Worksheet ' Data Sheet from data workbook
Dim WPN As Worksheet ' Report, in WBT


Set WBT = ThisWorkbook ' Sets 'WBT' equal to a workbook variable assigned to the seed file


' Variable assignment
Dim fso As New FileSystemObject ' Enables macro to search file explorer for files
Dim mtwFiles As Variant ' String that holds the file name
Dim ReamerID As String, Operator As String


ReamerID = Application.InputBox("Enter Reamer ID to be Analyzed.")
Operator = Application.InputBox("Enter Operators Seperated by a Comma.")


mtwFiles = Application.GetOpenFilename("mtwData Files (*.), *.mtwData)", 1, "Select Desired File.", "Select", False) ' Gets file names of shift/ctrl clicked files


' Stop formula updates for faster execution
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


' If file not chosen, break
If mtwFiles = False Then
MsgBox ("File not chosen.")
GoTo EndSub
Else


End If


''''''''''''' Open Workbook with m'th string name from mtwFiles string array
dataWorkbookFileName = fso.GetFileName(mtwFiles) ' Gets filename of file
Workbooks.Open mtwFiles ' Opens .mtwData Workbook




''''''''''''' Set workbook and worksheet variables
Set WBD = Workbooks(dataWorkbookFileName) ' 'WBD' gets set to the .mtwData workbook
Set WSD = WBD.Sheets(1) ' 'WSD' is the first sheet (the only sheet) in the .mtwData workbook
Set WPN = WBT.Sheets(1) ' 'WPN' is the first sheet (data table) in this report macro workbook


' Data workbook variable assignment
Const BLOCK_END As String = "DONE"
Dim rng As Range
Dim cell As Range
Dim aryColA As Variant
Dim aryColB As Variant
Dim firstAddress As String
Dim numArrays As Long
Dim idxArrays As Long
Dim firstrow As Long
Dim lastrow As Long
Dim numrows As Long


With WSD
numArrays = Application.CountIf(.Columns(1), BLOCK_END)
ReDim aryColA(1 To numArrays)
ReDim aryColB(1 To numArrays)
idxArrays = 1

firstrow = 2
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
If .Cells(lastrow, "A").Value <> BLOCK_END Then

lastrow = lastrow + 1
.Cells(lastrow, "A").Value = BLOCK_END
End If
Set rng = .Range("A2").Resize(lastrow - 1)

Set cell = Nothing

Set cell = .Columns(1).Find(What:=BLOCK_END, _
After:=.Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not cell Is Nothing Then

firstAddress = cell.Address
Do

lastrow = cell.Row
numrows = lastrow - firstrow
If numrows > 1 Then

aryColA(idxArrays) = .Cells(firstrow, "A").Resize(numrows)
aryColB(idxArrays) = .Cells(firstrow, "B").Resize(numrows)

idxArrays = idxArrays + 1
End If
firstrow = lastrow + 2
Set cell = .Columns(1).FindNext(cell.Offset(1, 0))
Loop While Not cell Is Nothing And cell.Address <> firstAddress And cell.Row <> 1
End If
End With


For wert = 1 To numArrays

' Copies previous sample's sheet to format for new sample
If WBT.Sheets(2).Cells(1, 2).Value = "" Then ' If this is the first sample
Set NewSheet = WBT.Sheets(WBT.Sheets.Count)
NewSheet.Name = "Hole 1" ' Changes this new sheets name to the specimen's name
Else
WBT.Sheets(WBT.Sheets.Count).Copy After:=WBT.Sheets(WBT.Sheets.Count) ' Copies previous sheet
Set NewSheet = WBT.Sheets(WBT.Sheets.Count) ' Sets NewSheet variable to new sheet
NewSheet.Range("A48:B15000").ClearContents ' Clears raw data values on specimen sheet starting on row 4
NewSheet.Name = "Hole " & wert ' Changes sheet name
End If

' Find max pos value
MaxDepth = WorksheetFunction.Min(aryColB(wert))

' Paste arrays into specimens worksheet (starting at row 48)
NewSheet.Range("A48:A" & UBound(aryColA(wert)) + 1) = WorksheetFunction.Transpose(aryColA(wert))
NewSheet.Range("B48:B" & UBound(aryColB(wert)) + 1) = WorksheetFunction.Transpose(aryColB(wert))

' Assign values to specimen's sheet
With NewSheet
.[B1].Value = ReamerID
.[B3].Value = MaxDepth
End With
Next wert


' Assign Values to Spreadsheet on Sheet 1
With WPN
.Cells(5, 6).Value = Operator
.Cells(5, 8).Value = numArrays
End With


' Calculate Formulas
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic


' Format by closing Data workbooks, and setting focus to 'Report' tab
Application.DisplayAlerts = False
Workbooks(dataWorkbookFileName).Close
Application.DisplayAlerts = True
WPN.Activate


' Sets screen updating back to true
Application.ScreenUpdating = True

' Prompt to save as .xlsm
saveAsName = Application.GetSaveAsFilename


If saveAsName = "False" Then


Else
WBT.SaveAs Filename:=saveAsName & "xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
End If


EndSub:
' Sets screen updating back to true
Application.ScreenUpdating = True


End Sub


24512

xld
06-27-2019, 10:18 AM
Seems to be a problem with your link.

xld
06-27-2019, 10:34 AM
There is no need to transpose the arrays, they are single column.

BTW, if you just want to copy the columns to another sheet, why bother with the arrays. You could just copy them and delete the DONE and blank rows.

mattreingold
06-27-2019, 12:20 PM
xld,

Here is the correct link: http://www.mediafire.com/file/3vd191usgz48aek/Combined_Data_1-102_RAW.xlsx/file

Im wanting to paste whats between each done into separate sheets, I.E if there are 102 DONE's, that means 102 tests - I want to plot the a and b cols of each test into a separate sheet (102 sheets).

My idea was to load each test between DONEs into arrays, then post each array into its test's sheet.

When you run the workbook with the data, hopefully you can see what I mean - there will be 102ish sheets for each test, each tests array is desired to be on cols a and b starting on row 48.

Thanks again for your continued help!

mattreingold
06-27-2019, 12:25 PM
Xld,

I took out the transpose as you suggested and it works exactly as intended! If you are curious run the data workbook I sent with this code, pretty neat!


Sub RunReport()

' Sets screen to not update for faster execution
Application.ScreenUpdating = False


' Establish All Workbook and Worksheet Variables
Dim WBT As Workbook ' This Workbook
Dim WBD As Workbook ' Data Workbook
Dim WSD As Worksheet ' Data Sheet from data workbook
Dim WPN As Worksheet ' Report, in WBT


Set WBT = ThisWorkbook ' Sets 'WBT' equal to a workbook variable assigned to the seed file


' Variable assignment
Dim fso As New FileSystemObject ' Enables macro to search file explorer for files
Dim mtwFiles As Variant ' String that holds the file name
Dim ReamerID As String, Operator As String


ReamerID = Application.InputBox("Enter Reamer ID to be Analyzed.")
Operator = Application.InputBox("Enter Operators Seperated by a Comma.")


mtwFiles = Application.GetOpenFilename("mtwData Files (*.), *.mtwData)", 1, "Select Desired File.", "Select", False) ' Gets file names of shift/ctrl clicked files


' Stop formula updates for faster execution
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


' If file not chosen, break
If mtwFiles = False Then
MsgBox ("File not chosen.")
GoTo EndSub
Else


End If


''''''''''''' Open Workbook with m'th string name from mtwFiles string array
dataWorkbookFileName = fso.GetFileName(mtwFiles) ' Gets filename of file
Workbooks.Open mtwFiles ' Opens .mtwData Workbook




''''''''''''' Set workbook and worksheet variables
Set WBD = Workbooks(dataWorkbookFileName) ' 'WBD' gets set to the .mtwData workbook
Set WSD = WBD.Sheets(1) ' 'WSD' is the first sheet (the only sheet) in the .mtwData workbook
Set WPN = WBT.Sheets(1) ' 'WPN' is the first sheet (data table) in this report macro workbook


' Data workbook variable assignment
Const BLOCK_END As String = "DONE"
Dim rng As Range
Dim cell As Range
Dim aryColA As Variant
Dim aryColB As Variant
Dim firstAddress As String
Dim numArrays As Long
Dim idxArrays As Long
Dim firstrow As Long
Dim lastrow As Long
Dim numrows As Long


With WSD
numArrays = Application.CountIf(.Columns(1), BLOCK_END)
ReDim aryColA(1 To numArrays)
ReDim aryColB(1 To numArrays)
idxArrays = 1

firstrow = 2
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
If .Cells(lastrow, "A").Value <> BLOCK_END Then

lastrow = lastrow + 1
.Cells(lastrow, "A").Value = BLOCK_END
End If
Set rng = .Range("A2").Resize(lastrow - 1)

Set cell = Nothing

Set cell = .Columns(1).Find(What:=BLOCK_END, _
After:=.Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not cell Is Nothing Then

firstAddress = cell.Address
Do

lastrow = cell.Row
numrows = lastrow - firstrow
If numrows > 1 Then

aryColA(idxArrays) = .Cells(firstrow, "A").Resize(numrows)
aryColB(idxArrays) = .Cells(firstrow, "B").Resize(numrows)

idxArrays = idxArrays + 1
End If
firstrow = lastrow + 2
Set cell = .Columns(1).FindNext(cell.Offset(1, 0))
Loop While Not cell Is Nothing And cell.Address <> firstAddress And cell.Row <> 1
End If
End With


For wert = 1 To numArrays

' Copies previous sample's sheet to format for new sample
If WBT.Sheets(2).Cells(1, 2).Value = "" Then ' If this is the first sample
Set NewSheet = WBT.Sheets(WBT.Sheets.Count)
NewSheet.Name = "Hole 1" ' Changes this new sheets name to the specimen's name
Else
WBT.Sheets(WBT.Sheets.Count).Copy After:=WBT.Sheets(WBT.Sheets.Count) ' Copies previous sheet
Set NewSheet = WBT.Sheets(WBT.Sheets.Count) ' Sets NewSheet variable to new sheet
NewSheet.Range("A48:B15000").ClearContents ' Clears raw data values on specimen sheet starting on row 4
NewSheet.Name = "Hole " & wert ' Changes sheet name
End If

' Find max pos value
MaxDepth = WorksheetFunction.Min(aryColB(wert))

' Paste arrays into specimens worksheet (starting at row 48)
NewSheet.Range("A48:A" & UBound(aryColA(wert)) + 1) = aryColA(wert)
NewSheet.Range("B48:B" & UBound(aryColB(wert)) + 1) = aryColB(wert)

' Assign values to specimen's sheet
With NewSheet
.[B1].Value = NewSheet.Name
.[B3].Value = MaxDepth
End With
Next wert


' Assign Values to Spreadsheet on Sheet 1
With WPN
.Cells(5, 6).Value = Operator
.Cells(5, 8).Value = numArrays
End With


' Calculate Formulas
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic


' Format by closing Data workbooks, and setting focus to 'Report' tab
Application.DisplayAlerts = False
Workbooks(dataWorkbookFileName).Close
Application.DisplayAlerts = True
WPN.Activate


' Sets screen updating back to true
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic


' Prompt to save as .xlsm
saveAsName = Application.GetSaveAsFilename


If saveAsName = "False" Then


Else
WBT.SaveAs Filename:=saveAsName & "xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
End If


EndSub:
' Sets screen updating back to true
Application.ScreenUpdating = True


End Sub

Thank you so much for your assistance, this has been extremely helpful!

xld
06-28-2019, 02:51 AM
I had a look at the final thing, and a couple of things jumped out at me.

Firstly, you ask the user to supply the ReamerId via an input box, but you don't seem to use it at all.

Secondly, it seems to me that you might be losing some items when you copy to the new sheets. The output starts in row 48, and you use this code


' Paste arrays into specimens worksheet (starting at row 48)
NewSheet.Range("A48:A" & UBound(aryColA(wert)) + 1) = aryColA(wert)
NewSheet.Range("B48:B" & UBound(aryColB(wert)) + 1) = aryColB(wert)
Just looking at that code, it looks to me that you are losing 47 rows. If the array has say 100 rows, you will be copying to the range A48:A101 when you should be copying to A48:A147. Better to use


' Paste arrays into specimens worksheet (starting at row 48)
NewSheet.Range("A48:A" & 48 + UBound(aryColA(wert)) + 1) = aryColA(wert)
NewSheet.Range("B48:B" & 48 + UBound(aryColB(wert)) + 1) = aryColB(wert)
or even better in my view is


' Paste arrays into specimens worksheet (starting at row 48)
NewSheet.Range("A48").Resize(UBound(aryColA(wert)) + 1) = aryColA(wert)
NewSheet.Range("B48").Resize( UBound(aryColB(wert)) + 1) = aryColB(wert)
or to be array safe (arrays can be base 0 or base1 1), I would use
[CODE]]
' Paste arrays into specimens worksheet (starting at row 48)
NewSheet.Range("A48").Resize(UBound(aryColA(wert)) - LBound(aryColA(wert)) + 1) = aryColA(wert)
NewSheet.Range("B48").Resize( UBound(aryColB(wert)) - LBound(aryColA(wert)) + 1) = aryColB(wertCODE]

mattreingold
07-01-2019, 08:08 AM
xld,

Thank you so much for checking out the end version - I'm very glad you did, losing rows would be pretty bad haha.

Also, good catch on the ReamerID - I definitely need to fix that, it indicates which test it was, after all lol.

I implemented the following, changing what is highlighted in blue (they should be the same size, tho):


' Paste arrays into specimens worksheet (starting at row 48)
NewSheet.Range("A48").Resize(UBound(aryColA(wert)) - LBound(aryColA(wert)) + 1) = aryColA(wert)
NewSheet.Range("B48").Resize( UBound(aryColB(wert)) - LBound(aryColB(wert)) + 1) = aryColB(wert

All seems to work without a hitch.

I really appreciate your time and effort in helping me!
Matt