Excel loop to extract information from cells

Question

I have this Table1 and is trying to achieve the results of Table2.

Current Data:

|                 A                            | 
150112 Charlston.jpg    
281320: (143,124,113) #8F7C71 srgb(143,124,113) 
1408099: (178,161,151) #B2A197 srgb(178,161,151)    
1685636: (200,183,173) #C8B7AD srgb(200,183,173)    

218600.jpg  
4385653: ( 29, 23, 29) #1D171D srgb(29,23,29)   
2192865: ( 76, 47, 69) #4C2F45 srgb(76,47,69)   
1409815: ( 96, 84,100) #605464 srgb(96,84,100)  

218622.jpg  
1519955: ( 30, 56, 57) #1E3839 srgb(30,56,57)   
1551616: ( 33, 62, 65) #213E41 srgb(33,62,65)   
2118603: ( 34, 58, 59) #223A3B srgb(34,58,59)

Expected results:

|          E         |  F | G | H |

                        R   G   B
150112 Charlston.jpg    143 124 113
150112 Charlston.jpg    178 161 151
150112 Charlston.jpg    200 183 173
218600.jpg              29  23  29
218600.jpg              76  57  69
218600.jpg              96  84  100
218622.jpg              30  56  57
218622.jpg              33  62  65
218622.jpg              34  58  59

What I need help with is the looping of finding the A column and x+5 row and copying it to D column 3 times down for each unique jpg name.

As for the R G B column, I have found the formula for the extracting the info from the cells.

For R

=MID($A2,FIND("(",$A2)+1,FIND(",",$A2)-FIND("(",$A2)-1)

For G

=MID($A2,FIND(",",$A2)+1,FIND(",",$A2)-FIND("(",$A2)-1)

For B

=MID($A2,(FIND(CHAR(7),SUBSTITUTE($A2,",",CHAR(7),4)))+1,(LEN($A2))-1-(FIND(CHAR(7),SUBSTITUTE($A2,",",CHAR(7),4))))

Is there a way to add this into the looping code so it would not hit an error from the blank and .jpg cells?

Thanks

Ron Rosenfeld · Accepted Answer

Since you have VBA in your tags, here is a VBA solution.

Note in the code comments that you have to set certain references, and also rename the class module to cRGB

In the regular module, you can put the output wherever you like, by changing wsRes and rRes (worksheet and top left cell of the range for the results) near the beginning of the module.

It outputs exactly what you show above.

The code uses regular expressions to extract the components.
It cycles through the data and starts a new class object whenever it finds the .jpg entry
Each object consists of the .jpg entry along with a collection (dictionary) of the associated RGB values
The class objects are collected in a dictionary.

The above method makes creating the output simpler and easy to modify for future needs.

Class Module

'Rename this module: cRGB

Option Explicit

Private pJPG As String
Private pR As Long
Private pG As Long
Private pB As Long
Private pRGB As String
Private pRGBs As Dictionary

Private Sub Class_Initialize()
    Set pRGBs = New Dictionary
End Sub

Public Property Get JPG() As String
    JPG = pJPG
End Property
Public Property Let JPG(Value As String)
    pJPG = Value
End Property

Public Property Get R() As Long
    R = pR
End Property
Public Property Let R(Value As Long)
    pR = Value
End Property

Public Property Get G() As Long
    G = pG
End Property
Public Property Let G(Value As Long)
    pG = Value
End Property

Public Property Get B() As Long
    B = pB
End Property
Public Property Let B(Value As Long)
    pB = Value
End Property

Public Property Get RGB() As String
    RGB = pRGB
End Property
Public Property Let RGB(Value As String)
    pRGB = Value
End Property

Public Property Get RGBs() As Dictionary
    Set RGBs = pRGBs
End Property
Public Function addRGBsItem()
  Dim V(2) As Variant
        V(0) = Me.R
        V(1) = Me.G
        V(2) = Me.B
        RGBs.Add Join(V, ","), V
End Function

Regular Module

'Set References to
'   Microsoft Scripting Runtime
'   Microsoft VBScript Regular Expressions 5.5
Option Explicit

Sub getRGB()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim dR As Dictionary, cR As cRGB
    Dim RE As RegExp, MC As MatchCollection, M As Match
    Const spatJPG As String = "^.*\.jpg\s*$"
    Const spatRGB As String = "$(\d+),(\d+),(\d+)$\s*$"
    Dim S As String, V As Variant, W As Variant, I As Long

'Set source and results worksheets
'   results range
'   Read source into vba array
Set wsSrc = Worksheets("Sheet")
Set wsRes = Worksheets("sheet1")
    Set rRes = wsRes.Cells(1, 1)

With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

'Initialize dictionary
Set dR = New Dictionary
    dR.CompareMode = TextCompare

'Initialize Regex
Set RE = New RegExp
With RE
    .IgnoreCase = True
    .MultiLine = True

'cycle through the source data
    For Each V In vSrc
        If Not V = "" Then
            .Pattern = spatJPG
            If .Test(V) = True Then
                S = V
                Set cR = New cRGB
                    cR.JPG = S
                    dR.Add Key:=S, Item:=cR
            Else
                .Pattern = spatRGB
                If .Test(V) = True Then
                    Set MC = .Execute(V)
                        With MC(0)
                            dR(S).R = .SubMatches(0)
                            dR(S).G = .SubMatches(1)
                            dR(S).B = .SubMatches(2)
                        End With
                        dR(S).addRGBsItem
                End If
            End If
        End If
    Next V
End With

'size results array
I = 0
For Each V In dR.Keys
    I = I + dR(V).RGBs.Count
Next V

ReDim vRes(0 To I, 1 To 4)

'Header Row
vRes(0, 1) = ""
vRes(0, 2) = "R"
vRes(0, 3) = "G"
vRes(0, 4) = "B"

'Populate the data
I = 0
For Each V In dR.Keys
    For Each W In dR(V).RGBs.Keys
        I = I + 1
        vRes(I, 1) = dR(V).JPG
        vRes(I, 2) = Split(W, ",")(0)
        vRes(I, 3) = Split(W, ",")(1)
        vRes(I, 4) = Split(W, ",")(2)
    Next W
Next V

Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
    .EntireColumn.Clear
    .Value = vRes
    With .Rows(1)
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    .EntireColumn.AutoFit
End With

End Sub

Excel loop to extract information from cells

Answers (2)

Related Questions