Resources
  • Home
  • December-Chrono
  • Psalm136Personalized
  • ExcelResources
    • 99PublicFunctions
    • aDelimitedCodeTemplate
    • aCodeTemplate
    • aBetter_Code_Template
    • ApplyFormulaValue
    • ArrayPublic
    • ArrayMatchCopyRow
    • Capitalization
    • Colors
    • DataTypes
    • DeleteRows
    • Filter
    • FormatStandard
    • Forms
    • Grid
    • Headers
    • ImageScrape
    • InputBox
  • ExcelResources2
    • Like
    • List Review
    • MatchAndReturn
    • mod_Import
    • Numbers
    • PDF_Parse
    • RandomGenerator
    • iRe1
    • Rept
    • RelatedItemsLIst
    • RomanNumerals
    • SheetSplitter
    • Sort
    • Split Method
    • String_DataType
    • TabDelimited
    • Tab_InsertNew_or_ClearExisting
    • Unique_List
      • UniqueLIsts_FilterMethod
  • Excelresources_Files
    • FileLists
    • FileTextParse
    • Folders
  • excelresources_WebScrape
    • CreateList_1-Href_2-Jpg
    • TableData_Load_PlugPlay
    • CreateList_MultiPage_Image_Link
      • ImageDownload_WebLink_List
    • TableData_Load_ClassDiv
    • TableData_Load_ClassSpan
  • Houseboat Vacation
  • At the Foot of the King
  • Devotions
  • Mentoring
  • Inspirational Stories
    • Vacuum Lifting
  • Job Help
  • Resources
    • MS
    • Florida History
  • Contact
  • Heroscape
    • Fish
    • Playstation
  • You Tube Videos
  • House
    • Tiny Houses
    • Backyards
  • CampingResources
    • CampingLand
    • LED Throwies
  • Interesting
  • Recipes
  • Xbox
  • Skydiving
  • ReadingPlan-5Year
  • Desoto
  • BibleStudy
  • HurricaneIrma
  • Home
  • December-Chrono
  • Psalm136Personalized
  • ExcelResources
    • 99PublicFunctions
    • aDelimitedCodeTemplate
    • aCodeTemplate
    • aBetter_Code_Template
    • ApplyFormulaValue
    • ArrayPublic
    • ArrayMatchCopyRow
    • Capitalization
    • Colors
    • DataTypes
    • DeleteRows
    • Filter
    • FormatStandard
    • Forms
    • Grid
    • Headers
    • ImageScrape
    • InputBox
  • ExcelResources2
    • Like
    • List Review
    • MatchAndReturn
    • mod_Import
    • Numbers
    • PDF_Parse
    • RandomGenerator
    • iRe1
    • Rept
    • RelatedItemsLIst
    • RomanNumerals
    • SheetSplitter
    • Sort
    • Split Method
    • String_DataType
    • TabDelimited
    • Tab_InsertNew_or_ClearExisting
    • Unique_List
      • UniqueLIsts_FilterMethod
  • Excelresources_Files
    • FileLists
    • FileTextParse
    • Folders
  • excelresources_WebScrape
    • CreateList_1-Href_2-Jpg
    • TableData_Load_PlugPlay
    • CreateList_MultiPage_Image_Link
      • ImageDownload_WebLink_List
    • TableData_Load_ClassDiv
    • TableData_Load_ClassSpan
  • Houseboat Vacation
  • At the Foot of the King
  • Devotions
  • Mentoring
  • Inspirational Stories
    • Vacuum Lifting
  • Job Help
  • Resources
    • MS
    • Florida History
  • Contact
  • Heroscape
    • Fish
    • Playstation
  • You Tube Videos
  • House
    • Tiny Houses
    • Backyards
  • CampingResources
    • CampingLand
    • LED Throwies
  • Interesting
  • Recipes
  • Xbox
  • Skydiving
  • ReadingPlan-5Year
  • Desoto
  • BibleStudy
  • HurricaneIrma
Connect on Facebook

Create Related Items List:

Reviews array to find all values matching Col A value
 - Creates a string of Results containing the values from Col B
 - Removes duplicates from the results
 - Adds/Omits " and" depending on if multiple results in final string.

This <myPatternMatchVal> is also available in <myColorMatchval>
 = This <Jigsaw> pattern is also available in <Midnight, Sand and Shell>.
 = This <Jasper> pattern is also available in <Curry>.

Function LoadRelated(ByRef myArray As Variant, myPatternMatchVal As Variant, myColorMatchVal As Variant, myMatchCol As Variant, myAssembleStringCol As Variant) As String
'Needs an array to loop through - usually aData(cells(1,1),cells(ire1,ice1))
'Needs data to match (Single String: [myColorMatchVal] & the corresponding Column location [myMatchCol])
'Creates a concatenated string of all values matching that string in the array that are located in an offsetting column - will not include the value from the same row: [myColorMatchVal]
'Needs a column location to put the results back into the array: [myAssebmleStringCol]
'Note: Will clean the string so that no dupes are included (by reviewing and re-stringing the string)
'      Will include and if multiple values in final string or omit it if it is the only value
'Example: sRelatedSKUs = LoadRelated(myDataArray, sColPattern, sColSKU, iColPattern, iColSKU)

Dim sPatternMatchVal As String, sColorMatchVal As String, iColMatch As Long, iColAssemble As String, iLoop As Long, iLastComma As Long, iFirstComma As Long
Dim aSplitMe As Variant, sNoDupe As String

sPatternMatchVal = myPatternMatchVal
sColorMatchVal = myColorMatchVal
iColMatch = myMatchCol * 1
iColAssemble = myAssembleStringCol * 1

'Return [Blank] value to begin with:
LoadRelated = ""


For iLoop = LBound(myArray) + 1 To UBound(myArray)
    If UCase(Trim(myArray(iLoop, iColMatch))) = UCase(Trim(myPatternMatchVal)) Then
        LoadRelated = LoadRelated & myArray(iLoop, iColAssemble) & ", "
    End If
    
Next iLoop

'remove any duplicates of the same value as the current color being reviewed
LoadRelated = Replace(LoadRelated, sColorMatchVal & ", ", "", , , vbTextCompare)
'remove trailing commas
If Right(LoadRelated, 2) = ", " Then LoadRelated = Left(LoadRelated, Len(LoadRelated) - 2)
If Right(LoadRelated, 1) = "," Then LoadRelated = Left(LoadRelated, Len(LoadRelated) - 1)

If InStr(1, LoadRelated, ",", vbTextCompare) > 0 Then GoTo gRemoveDupes
    GoTo gFunctionComplete
    
gRemoveDupes:
    'Set the value to blank:
    sNoDupe = ""
    
    'Split the string into individual chunks
    aSplitMe = Split(LoadRelated, ",", , vbTextCompare)
    
    'Loop through each chunk - assess and ignore/re-assemble
    For iLoop = LBound(aSplitMe) To UBound(aSplitMe)
        'Ignore if already exists in new string
        If InStr(1, sNoDupe, aSplitMe(iLoop), vbTextCompare) > 0 Then GoTo gNextRemoveDupeLoop
            
            'Add to new string if not already there.
            sNoDupe = sNoDupe & StrConv((aSplitMe(iLoop)), vbProperCase) & ", "
gNextRemoveDupeLoop:
    Next iLoop
    
    'final clean when finished with re-assemble
        If Right(sNoDupe, 2) = ", " Then sNoDupe = Left(sNoDupe, Len(sNoDupe) - 2)
        iLastComma = InStrRev(sNoDupe, ",", , vbTextCompare)
        iFirstComma = InStr(1, sNoDupe, ",", vbTextCompare)
            If iLastComma > 0 Then sNoDupe = Left(sNoDupe, iLastComma - 1) & " and " & Right(sNoDupe, Len(sNoDupe) - iLastComma)
       
        iFirstComma = InStr(1, sNoDupe, "  ", vbTextCompare)
        Do While iFirstComma > 0
        DoEvents
            sNoDupe = Replace(sNoDupe, "  ", " ", , , vbTextCompare)
            iFirstComma = InStr(1, sNoDupe, "  ", vbTextCompare)
        Loop
        LoadRelated = sNoDupe
    GoTo gFunctionComplete
    

gFunctionComplete:
End Function

Powered by Create your own unique website with customizable templates.
  • Home
  • December-Chrono
  • Psalm136Personalized
  • ExcelResources
    • 99PublicFunctions
    • aDelimitedCodeTemplate
    • aCodeTemplate
    • aBetter_Code_Template
    • ApplyFormulaValue
    • ArrayPublic
    • ArrayMatchCopyRow
    • Capitalization
    • Colors
    • DataTypes
    • DeleteRows
    • Filter
    • FormatStandard
    • Forms
    • Grid
    • Headers
    • ImageScrape
    • InputBox
  • ExcelResources2
    • Like
    • List Review
    • MatchAndReturn
    • mod_Import
    • Numbers
    • PDF_Parse
    • RandomGenerator
    • iRe1
    • Rept
    • RelatedItemsLIst
    • RomanNumerals
    • SheetSplitter
    • Sort
    • Split Method
    • String_DataType
    • TabDelimited
    • Tab_InsertNew_or_ClearExisting
    • Unique_List
      • UniqueLIsts_FilterMethod
  • Excelresources_Files
    • FileLists
    • FileTextParse
    • Folders
  • excelresources_WebScrape
    • CreateList_1-Href_2-Jpg
    • TableData_Load_PlugPlay
    • CreateList_MultiPage_Image_Link
      • ImageDownload_WebLink_List
    • TableData_Load_ClassDiv
    • TableData_Load_ClassSpan
  • Houseboat Vacation
  • At the Foot of the King
  • Devotions
  • Mentoring
  • Inspirational Stories
    • Vacuum Lifting
  • Job Help
  • Resources
    • MS
    • Florida History
  • Contact
  • Heroscape
    • Fish
    • Playstation
  • You Tube Videos
  • House
    • Tiny Houses
    • Backyards
  • CampingResources
    • CampingLand
    • LED Throwies
  • Interesting
  • Recipes
  • Xbox
  • Skydiving
  • ReadingPlan-5Year
  • Desoto
  • BibleStudy
  • HurricaneIrma