I have been given this script to help sort my data, but I have tried to use it but I always get errors.
Can someone please apply the script to my excel file and solve the issue?
Link for the file -
https://wetransfer.com/<wbr>downloads/<wbr>127ca2b06c123afe7ad4a9b554929b<wbr>0420170914135128/<wbr>55446f732785bfcfa39adba455b810<wbr>a220170914135128/10ecb5
[h=2]Script -[/h]
Module Code:
Option Explicit 'Handles the extraction of data
Public Sub ExtractSampleList()
Dim rngInput
As Range
Dim rngSmpls
As Range
Dim strCharCode
As String
Dim varWrkCell
As Variant
Dim colSmpls
As Collection
Dim clsOutputs
As OutputClass
'Get the input and set the search range
With wsInputSheet
Set rngInput = .Range("SelectionInput")
Set rngSmpls = .Range("SampleList")
End With
'Get the Single Letter Character Code
strCharCode = Left(rngInput.Value2, 1)
'Search the range where the samples are located
Set colSmpls =
New Collection
For Each varWrkCell
In rngSmpls
'If the first character of the sample equals the single character code then extract the data
If Left(varWrkCell.Value2, 1) = strCharCode
Then
'Set up new instance of class and construct it
Set clsOutputs =
New OutputClass
Call clsOutputs.Construct(varWrkCell)
'Add class instance to collection
colSmpls.Add clsOutputs
End If
Next varWrkCell
'Call the output routine (passing the collection of objects extracted
Call OutputData(colSmpls)
'Clear up objects
Set rngInput =
Nothing
Set rngSmpls =
Nothing
Set varWrkCell =
Nothing
Set colSmpls =
Nothing
Set clsOutputs =
Nothing
End Sub
Private Sub OutputData(
ByRef colSmpls
As Collection)
Dim lngOutputRow
As Long: lngOutputRow = 1
'Assuming Header in row 1 so this will move to row 2 on entering the loop
Dim lngChrCdCol
As Long: lngChrCdCol = 7
Dim lngSmplCol
As Long: lngSmplCol = 8
Dim clsOutputs
As OutputClass
'Loop round each object in the collection and output
With wsOutputSheet
For Each clsOutputs
In colSmpls
lngOutputRow = lngOutputRow + 1
.Cells(lngOutputRow, lngChrCdCol) = clsOutputs.CharacterCode
.Cells(lngOutputRow, lngSmplCol) = clsOutputs.CharacterCode & " " & clsOutputs.SampleData
Next clsOutputs
End With
End Sub
Class Module Code:
Option Explicit
Private pStr_SampleData
As String
Private pStr_CharCode
As String
Public Sub Construct(
ByRef varInput
As Variant)
Dim varSplitString
As Variant
varSplitString = Split(
CStr(varInput.Value2), " ", 2)
pStr_CharCode = varSplitString(0)
pStr_SampleData = varSplitString(1)
End Sub
Public Property Get CharacterCode()
As String
CharacterCode = pStr_CharCode
End Property
Public Property Get SampleData()
As String
SampleData = pStr_SampleData
End Property
Appreciate all your help.
</pre>
