PDA

View Full Version : Get a Cell into a Standard Format depending on its Contents - UDF/Formula Only



New_Here
04-24-2017, 11:08 PM
Hi Guys Good Morning from Sri Lanka,

I want a favor with regards to getting a Cell formatted to a standard Cell.

What I have:

A1=Green Hoodie: 5
A2=Green Hoodie: 10 Black Hoodie: -
A3=White Hoodie: 4

What I Need:

B1=Green Hoodie: 5 Black Hoodie: N/A White Hoodie: N/A
B2=Green Hoodie: 10 Black Hoodie: N/A White Hoodie: N/A
B3=Green Hoodie: N/A Black Hoodie: N/A White Hoodie: 4

At times we get the Number along with the words like Pieces, or pcs...but that's completely Fine. Therefore when you make the UDF/formuala please regard the number string which appear here irrelevant as a Text or Numeric

ex:
A1=Green Hoodie: 5pcs
A1=Green Hoodie: 5Nos

Thank you...

Paul_Hossler
04-25-2017, 06:29 AM
Try this




Option Explicit

'very similar to
'http://www.vbaexpress.com/forum/showthread.php?59247-Please-Modify-this-VBA-for-New-Requirement-Or-Provide-a-New-One

Function BreakOut3(s As String) As String
Dim v As Variant, v1 As Variant
Dim i As Long, n As Long
Dim s1 As String, s2 As String
Dim aOut(1 To 3, 1 To 2) As String

Application.Volatile

aOut(1, 1) = "Green"
aOut(2, 1) = "Black"
aOut(3, 1) = "White"
aOut(1, 2) = "N/A"
aOut(2, 2) = "N/A"
aOut(3, 2) = "N/A"


s1 = s
s1 = Replace(s1, " Hoodie", vbNullString)
s1 = Replace(s1, " Green", Chr(1) & "Green")
s1 = Replace(s1, " Black", Chr(1) & "Black")
s1 = Replace(s1, " White", Chr(1) & "White")


v = Split(s1, Chr(1))

For i = LBound(v) To UBound(v)
v1 = Split(v(i), ":")
Select Case v1(0)
Case "Green": n = 1
Case "Black": n = 2
Case "White": n = 3
End Select

If IsNumeric(v1(1)) Then
aOut(n, 2) = v1(1)

Else
Do While Len(v1(1)) > 0 And Not IsNumeric(v1(1))
v1(1) = Left(v1(1), Len(v1(1)) - 1)
Loop
If Len(v1(1)) > 0 Then
aOut(n, 2) = v1(1)
End If
End If
Next i


s1 = vbNullString
For i = LBound(aOut, 1) To UBound(aOut, 1)
s1 = s1 & aOut(i, 1) & " Hoodie: " & aOut(i, 2) & IIf(i < UBound(aOut, 1), " ", vbNullString)
Next i

BreakOut3 = s1
End Function

New_Here
04-25-2017, 07:14 AM
Yes Brother, requirement change depending on our customer and what we have to do with their Data, its hard to over see some expectations of them...

Thanks a lot for your support...

Just asking as the UDF looks massive, will this not slow down the Excel, due to the amount of coding?

New_Here
04-25-2017, 07:16 AM
...and another problem is I do not Know VBA,

Specially from BreakOut1&2 I could have never come up with this to code...

Thank you again and again for your kind support...

Paul_Hossler
04-25-2017, 08:22 AM
Just asking as the UDF looks massive, will this not slow down the Excel, due to the amount of coding?


In general, the number of VBA lines does not affect performance nearly as much as things such as For/Next loops and the necessity to handle special cases such as "pcs" and "Nos"

Paul_Hossler
04-25-2017, 08:26 AM
...and another problem is I do not Know VBA,

If you have a little programming experience, VBA is not that hard to become familiar with. I'm still impressed by many of the real VBA pros and experts that visit here

Read through a macro and hit F1 to get the help on any unfamiliar terms, but many times you can make a fairly good guess

For example, "Replace" replaces something, "Split" splits something, etc.

New_Here
04-25-2017, 09:48 PM
While Thanking you again...

I have a small request but a bit big in Size... :crying: :) you see my records always vary along these lines...which means its always a little bit of adjustment here and there...

Is there a possibility not to hard code the below features to the Macro itself, but in Cells..

Ex:
1. Lets say in some data I might have 3 sets of info Remember the Breakout 1 : Phone Fax and Mobile
2. Some data I might have 2 sets of info Remember the Breakout 2 : Name and Designation
3. The Trilogy is connecting the both lol, you directed Breakout 3 :rofl: : Hoodies...
4. Number of cells I will have to highlight always equals to : sets of data by 2, ex: 1. 6, ex: 2. 4, and this ex: a 6 again...
5. Do you think you can manage to Direct Part 4 by doing something like this will say we make the Macro look into A1, B1, C1, D1, E1...If data available in any, the Data will be the Headers (A1:Phone B1:Fax C1:Mobile) etc...the rest completely depend on the number of headings and if no data is available with or without the header, make the header appear with "N/A"...

6. Do you think this is asking too much? Because in all 3 instances you managed to crack the case...
7. Then I can number the Function like Breakout - 1,2,3,4 and leave the rest for the Macro to do... (Then when there are 2 similar scenarios in One Sheet I can change a New Breakout Number with A2, B2, C2, D2, E2....etc...

Thank you again... Sorry for all the Trouble I have given you... Trust me I have been :banghead: for past few weeks now...

New_Here
04-25-2017, 09:57 PM
Read through a macro and hit F1 to get the help on any unfamiliar terms, but many times you can make a fairly good guess

For example, "Replace" replaces something, "Split" splits something, etc. You know bro, I opened up your VBA and tried to figure out the result area and hoping it will work, tried adding N/A and stuff :devil2: :dunno :banghead:...only to realize it was debugging and excel started to Freeze... I was in a mess... lol...then you just coded this massive macro... I feel sorry for myself...

Paul_Hossler
04-26-2017, 07:58 PM
Actually, I sort of expected it

Try this in the attachment

The WS Data col A is a list of words to be deleted (like pcs and Nos) is you want

The other columns are the list of key words. The UDF will take the input string, get any data associated with any keywords and construct the output string


19039








Option Explicit

Sub drv()

MsgBox BreakOutAll("Green Hoodie: 10 Black Hoodie: -", Worksheets("Data").Columns(2), Worksheets("Data").Columns(1))
MsgBox BreakOutAll("Green Hoodie: 10pcs Black Hoodie: -", Worksheets("Data").Columns(2), Worksheets("Data").Columns(1))

MsgBox BreakOutAll("Phone: 51-83-9498756, 5583772359 Fax: 61-88-4932516", Worksheets("Data").Columns(3))
MsgBox BreakOutAll("Phone: 51-6785239556 Fax: 31-13-45225335 Mobile: -", Worksheets("Data").Columns(3))
MsgBox BreakOutAll("Contact Person: James Anderson Designation: Proprietor", Worksheets("Data").Columns(4))
MsgBox BreakOutAll("Contact Person: Gordan, David Designation: Seller Things", Worksheets("Data").Columns(4))
MsgBox BreakOutAll("Contact Person: David Cameron Miller Designation: Vice President", Worksheets("Data").Columns(4))

End Sub

'
Function BreakOutAll(s As String, KeyWords As Range, Optional Exceptions As Range = Nothing) As String
Dim i As Long, nStart As Long, j As Long
Dim s1 As String, s2 As String
Dim aOut() As String
Dim r1 As Range, x1 As Range
Dim v As Variant, v1 As Variant


Application.Volatile

Set r1 = KeyWords.Columns(1)
Set r1 = r1.Cells(1, 1)
Set r1 = Range(r1, r1.End(xlDown))

If Exceptions Is Nothing Then
Set x1 = Nothing
Else
Set x1 = Exceptions.Columns(1)
Set x1 = x1.Cells(1, 1)
Set x1 = Range(x1, x1.End(xlDown))
If x1.Rows.Count = x1.Parent.Rows.Count Then Set x1 = Nothing
End If

ReDim aOut(1 To r1.Rows.Count, 1 To 2)

'store key words, replacing space with chr(3)
For i = LBound(aOut, 1) To UBound(aOut, 1)
aOut(i, 1) = r1.Cells(i, 1).Value
aOut(i, 1) = Replace(aOut(i, 1), " ", Chr(3))
aOut(i, 2) = "N/A"
Next I

'get rid of multiple spaces
s1 = s
Do While InStr(s1, " ") > 0
s1 = Replace(s1, " ", " ")
s1 = Trim(s1)
Loop


'handle multiple data in single keyword (e.g. Phone: 999888777, 111222333) to keep together
s1 = Replace(s1, ", ", Chr(1))

'go through list of all possible keywords and put Chr(2) in front if space
For i = LBound(aOut, 1) To UBound(aOut, 1)
nStart = InStr(s1, " " & aOut(i, 1))

'if keyword is there, ...
If nStart > 0 Then
Mid(s1, nStart, 1) = Chr(2)
End If

Next I

'make " " = Chr(3)
s1 = Replace(s1, " ", Chr(3))

'Original where a _ represents a space
'Contact_Person:_Gordan,_David_Designation:_Seller_Things

'Replaced where 1=comma+space, 2=space+keyfield, 3=space
'Contact3Person:3Gordan1David2Designation:3Seller3Things
' 1 2 3 4 5
'1234567890123456789012345678901234567890123456789012345
v = Split(s1, Chr(2))

'v(0)
'Contact3Person:3Gordan1David
'v(1)
'Designation:3Seller3Things
For j = LBound(v) To UBound(v)
v1 = Split(v(j), ":" & Chr(3))
'v1(0)
'Contact3Person
'v1(1)
'Gordan1David

'go through list of all possible keywords
For i = LBound(aOut, 1) To UBound(aOut, 1)
If UCase(aOut(i, 1)) = UCase(v1(0)) Then
aOut(i, 2) = v1(1)
'if it's a dash, make N/A again
If aOut(i, 2) = "-" Then aOut(i, 2) = "N/A"
End If
Next I
Next j

'if ther are Exceptions, replace exception list in all data
If Not x1 Is Nothing Then
For i = LBound(aOut, 1) To UBound(aOut, 1)
If aOut(i, 2) <> "N/A" Then
If Not IsNumeric(aOut(i, 2)) Then
For j = 1 To x1.Rows.Count
aOut(i, 2) = Replace(aOut(i, 2), x1.Cells(i, 1), vbNullString, 1, -1, vbTextCompare)
Next j
End If
End If
Next I
End If
'fix strings by removing markers
For i = LBound(aOut, 1) To UBound(aOut, 1)
aOut(i, 1) = Replace(aOut(i, 1), Chr(3), " ")
aOut(i, 1) = Replace(aOut(i, 1), Chr(1), ", ")
aOut(i, 2) = Replace(aOut(i, 2), Chr(3), " ")
aOut(i, 2) = Replace(aOut(i, 2), Chr(1), ", ")
Next i

'build the string
s1 = vbNullString
For i = LBound(aOut, 1) To UBound(aOut, 1)
s1 = s1 & aOut(i, 1) & ": " & aOut(i, 2) & IIf(i < UBound(aOut, 1), " ", vbNullString)
Next I

'put back the ", "
BreakOutAll = Trim(Replace(s1, Chr(1), ", "))
End Function