Complex Script Question

[Hyperlite]

Hi everyone,

I have somewhat of an issue figuring out a method to script this in excel. I have an excel document that contains a couple bits of information, and I need to sort it with logic in a specific manner. A single cell contains numerous values seperated by a ", " (comma followed by space). The output format must also stay using a single cell for multiple values for the script to be useful.

I want to organize the info in the Ref Des column of Chart 1 according to the data on Chart 2. It will also then tally up the total number of values in each of those formatted cells and display the total number of individual values in that cell.

Chart 1:
Known Data on Sheet 1 of Excell Document 1 (logic not applied to far 4 columns)

Line Item #	Ref Des	Ref Des T	QTY on T	Ref Des B	QTY on B	Total QTY
1	R100, R102, R104, R105					4
2	U1, U2, U13					3
3	C3, C105, C225, L24					4

<tbody>
</tbody>

Chart 2:
Known Data on Sheet 2 of Excell Document 1

Ref Des	T or B
R100	TOP
R102	BOTTOM
R104	BOTTOM
R105	BOTTOM
U1	TOP
U2	TOP
U13	BOTTOM
C3	TOP
C105	TOP
C225	BOTTOM
L24	BOTTOM

<tbody>
</tbody>

Chart 3:
Desired Output Format from using script or logic on Sheet 1/Sheet 2 next to known data from above. The italicized headings are for reference. The italicized and bolded values are the desired outputs I should get from a successful script.

Known Above	Known Above	Applied Logic Column	Applied Logic Column	Applied Logic Column	Applied Logic Column	Known Above
Line Item #	Ref Des	Ref Des T	QTY on T	Ref Des B	QTY on B	Total QTY
1	R100, R102, R104, R105	R100	1	R102, R104, R105	3	4
2	U1, U2, U13	U1, U2	2	U13	1	3
3	C3, C105, C225, L24	C3, C105	2	C225, L24	2	4

<tbody>
</tbody>

We currently have a script that can do this, but it has some limitations and is not imbedded inside excel. I want to be able to undersatnd how the script works as the values are not always seperated by just a ", " (comma followed by space) but also sometimes just a " " (space) or "," (comma with no space) etc. (documents do not mix seperation styles, they just use one or the other). The excel documents we are doing this to are much more complex than what I am showing here as this is a more simplistic view for asking the question. (The Ref Des cells can have 100's of values seperated by ","/" "/", " not just 3 or 4, and there can be 100's of line items, not just 3 or 4). However, the complexity of the data should not matter as the basic functionality of the script would be the same in my opinion.

If this is not possible in excel, please suggest or point me in the direction of some other methods I could look into to acheive this. Currently, seperating this by hand is extremely time consuming I thought about using VBScript to do this, but wanted to see if it was possible inside Excel first.

I tried to be as thorough as possible in explaining what I want to achieve, but as an engineer I can sometimes leave details out that might be needed to solve the problem. I will try to keep tabs on this thread from my phone to answer any questions that may arise.

Thank you.

 

[bertie]

Hi, an welcome to the forum.

Here is a VBA solution to your problem.

I have created two object variables,
One to loop through column B of sheet1, named rngSheet1;
The other for sheet2, named wsRef.

   [COLOR=darkblue]Set[/COLOR] rngSheet1 = Sheets("Sheet1").Range("B2")
   [COLOR=darkblue]Set[/COLOR] wsRef = Sheets("Sheet2")

We loop through column B and split the individual values into an array, based on the comma separator, edit this to meet your needs.

   [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] rngSheet1 = ""
      [COLOR=green]'spilit into the array on comma[/COLOR]
      arrRef = Split(rngSheet1.Value, [COLOR=#ff0000]","[/COLOR])

We then loop through the array and determine if each value corresponds to "TOP" or "BOTTOM". I have written a separate Function for this process named, FindRef(). The function uses the Find() function to search Sheet2 column(1) for the ref and returns the value in the adjacent column.

      [COLOR=darkblue]For[/COLOR] i = [COLOR=darkblue]LBound[/COLOR](arrRef) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](arrRef)
         strTemp = FindRef(wsRef, Trim(arrRef(i)))

The function returns TOP or BOTTOM to the strTemp variable. We test this using a Select Case statement. We also determine the column offset here for output.

For example if strTemp="TOP"

Select Case UCase(strTemp)
            Case "TOP"
               If rngSheet1.Offset(, 1).Value = "" Then
                  rngSheet1.Offset(, 1).Value = arrRef(i)
               Else
                  rngSheet1.Offset(, 1).Value = rngSheet1.Offset(, 1).Value & ", " & arrRef(i)
               End If
               rngSheet1.Offset(, 2).Value = rngSheet1.Offset(, 2).Value + 1

The full code is below.
To test:
Create a new Excel file and place your sample data in Sheet1 and Sheet2.
Press ALt+F11 to open the VBA Editor window.
Double click the ThisWorkbook module in the Project Window on the left hand side.
Copy and paste the code.
Press F5 to run or F8 to step through the code(recommended for a better understanding of how the code works.).

[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]


[COLOR=darkblue]Sub[/COLOR] Main()
   [COLOR=darkblue]Dim[/COLOR] rngSheet1 [COLOR=darkblue]As[/COLOR] Range
   [COLOR=darkblue]Dim[/COLOR] wsRef [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]Dim[/COLOR] arrRef [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]      [COLOR=green]'array of references[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]              [COLOR=green]'loop variable[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] strTemp [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   
   [COLOR=darkblue]Set[/COLOR] rngSheet1 = Sheets("Sheet1").Range("B2")
   [COLOR=darkblue]Set[/COLOR] wsRef = Sheets("Sheet2")
   
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] errExit
   
   [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] rngSheet1 = ""
      [COLOR=green]'spilit into the array on comma[/COLOR]
      arrRef = Split(rngSheet1.Value, ",")
      
      [COLOR=darkblue]For[/COLOR] i = [COLOR=darkblue]LBound[/COLOR](arrRef) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](arrRef)
         strTemp = FindRef(wsRef, Trim(arrRef(i)))
         
         [COLOR=green]'output[/COLOR]
         [COLOR=darkblue]Select[/COLOR] [COLOR=darkblue]Case[/COLOR] U[COLOR=darkblue]Case[/COLOR](strTemp)
            [COLOR=darkblue]Case[/COLOR] "TOP"
               [COLOR=darkblue]If[/COLOR] rngSheet1.Offset(, 1).Value = "" [COLOR=darkblue]Then[/COLOR]
                  rngSheet1.Offset(, 1).Value = arrRef(i)
               [COLOR=darkblue]Else[/COLOR]
                  rngSheet1.Offset(, 1).Value = rngSheet1.Offset(, 1).Value & ", " & arrRef(i)
               [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
               rngSheet1.Offset(, 2).Value = rngSheet1.Offset(, 2).Value + 1
               
               
            [COLOR=darkblue]Case[/COLOR] "BOTTOM"
               [COLOR=darkblue]If[/COLOR] rngSheet1.Offset(, 3).Value = "" [COLOR=darkblue]Then[/COLOR]
                  rngSheet1.Offset(, 3).Value = arrRef(i)
               [COLOR=darkblue]Else[/COLOR]
                  rngSheet1.Offset(, 3).Value = rngSheet1.Offset(, 3).Value & ", " & arrRef(i)
               [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
               rngSheet1.Offset(, 4).Value = rngSheet1.Offset(, 4).Value + 1
            
            
            Case [COLOR=darkblue]Else[/COLOR]
               [COLOR=green]'not found[/COLOR]
               'code for ref not found goes here
         [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Select[/COLOR]
         
         [COLOR=green]'calculate total[/COLOR]
         rngSheet1.Offset(, 5).Value = _
            rngSheet1.Offset(, 2).Value + rngSheet1.Offset(, 4).Value
      [COLOR=darkblue]Next[/COLOR] i
      
      [COLOR=green]'next row[/COLOR]
      [COLOR=darkblue]Set[/COLOR] rngSheet1 = rngSheet1.Offset(1, 0)
   [COLOR=darkblue]Loop[/COLOR]
   
errExit:
   [COLOR=green]'tidy up and release memory[/COLOR]
   [COLOR=darkblue]Set[/COLOR] rngSheet1 = [COLOR=darkblue]Nothing[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wsRef = [COLOR=darkblue]Nothing[/COLOR]
   
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]




[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Function[/COLOR] FindRef([COLOR=darkblue]ByVal[/COLOR] ws [COLOR=darkblue]As[/COLOR] Worksheet, _
                         [COLOR=darkblue]ByVal[/COLOR] ref [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]) [COLOR=darkblue]As[/COLOR] String
   [COLOR=darkblue]Dim[/COLOR] rngFound [COLOR=darkblue]As[/COLOR] Range
   
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
      [COLOR=darkblue]With[/COLOR] ws
         [COLOR=darkblue]Set[/COLOR] rngFound = .Columns(1).Find(What:=ref, _
                        After:=.Cells(1, 1), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False, _
                        SearchFormat:=False)
         [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
      
   [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] rngFound [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
      FindRef = rngFound.Offset(, 1).Value
   [COLOR=darkblue]Else[/COLOR]
      FindRef = ""
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
End [COLOR=darkblue]Function[/COLOR]

Bertie

 

[Hyperlite]

Thanks a bunch for the quick reply Bertie. I will play around with this tomorrow at work and post any questions I might have.