HI,
Hope this will meet your expectation
Sub SeperateData()
Dim varVal As Variant
Dim lngLoop As Long
Dim rngRange As Range
Dim strIni As String
Dim strFinal As String
Dim strTemp As String
Dim lngVal As Long
Dim lngCell As Long
Set rngRange = ActiveSheet.Range("E6:E34")
For lngCell = 0 To rngRange.Rows.Count
If LCase(rngRange.Resize(1, 1).Offset(lngCell).Value) Like "?x*" Or
LCase(rngRange.Resize(1, 1).Offset(lngCell).Value) Like "x*" Then
varVal = Split(rngRange.Resize(1, 1).Offset(lngCell), ",")
For lngLoop = LBound(varVal) To UBound(varVal)
If LCase(varVal(lngLoop)) Like "x*" Or
LCase(varVal(lngLoop)) Like "?x*" Then
strIni = varVal(lngLoop)
strFinal = strIni
Else
strTemp = ""
For lngVal = 0 To UBound(Split(strIni, "-"))
If lngVal < UBound(Split(strIni, "-")) Then
strTemp = strTemp & IIf(Split(strIni,
"-")(lngVal) <> "", Split(strIni, "-")(lngVal), "-")
End If
Next lngVal
If Evaluate("=mid(""" & varVal(lngLoop) & """,1,1)") =
"-" Then
varVal(lngLoop) = Evaluate("=mid(""" &
varVal(lngLoop) & """,2,LEN(""" & varVal(lngLoop) & """)-1)")
End If
strFinal = strTemp & "-" & varVal(lngLoop)
End If
rngRange.Resize(1, 1).Offset(lngCell + lngLoop).Value =
strFinal
Next lngLoop
End If
Next lngCell
End Sub
Regards,
Lalit Mohan
www.excelfox.com/forum
From: excel-macros@googlegroups.com [mailto:excel-macros@googlegroups.com]
On Behalf Of vijay yadav
Sent: Thursday, June 28, 2012 4:49 PM
To: excel-macros@googlegroups.com
Subject: $$Excel-Macros$$ Re: want data seperated by hypen - and comma , to
be written in rows existing below eg X6-1,4,5,6,9,X7-23,56,67,X30 in cell
c34 to be written as X6-1 in cell c34 X6-4 in cell c35 and so on..
Thanks Lalit_Mohan for the prompt reply
But still iam not getting the expected output.
I am attaching excel sheet ,please have a look and help me with the macro.
Regards
Vijay
On Thursday, 28 June 2012 16:21:07 UTC+5:30, Lalit_Mohan wrote:
Hi Vijay,
Hope it helps you
Sub SeperateData()
Dim varVal As Variant
Dim lngLoop As Long
Dim rngRange As Range
Dim strIni As String
Dim strFinal As String
Set rngRange = ActiveSheet.Range("A1")
varVal = Split(rngRange.Value, ",")
For lngLoop = LBound(varVal) To UBound(varVal)
If LCase(varVal(lngLoop)) Like "x*" Then
strIni = varVal(lngLoop)
strFinal = strIni
Else
strFinal = Split(strIni, "-")(0) & "-" & varVal(lngLoop)
End If
rngRange.Offset(lngLoop) = strFinal
Next lngLoop
End Sub
change accordingly
Regards,
Lalit Mohan
--
FORUM RULES (986+ members already BANNED for violation)
1) Use concise, accurate thread titles. Poor thread titles, like Please
Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will
not get quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security
measure.
4) Acknowledge the responses you receive, good or bad.
5) Cross-promotion of, or links to, forums competitive to this forum in
signatures are prohibited.
NOTE : Don't ever post personal or confidential data in a workbook. Forum
owners and members are not responsible for any loss.
----------------------------------------------------------------------------
--------------------------
To post to this group, send email to excel-macros@googlegroups.com
To unsubscribe, send a blank email to
excel-macros+unsubscr...@googlegroups.com
--
FORUM RULES (986+ members already BANNED for violation)
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Cross-promotion of, or links to, forums competitive to this forum in
signatures are prohibited.
NOTE : Don't ever post personal or confidential data in a workbook. Forum
owners and members are not responsible for any loss.
------------------------------------------------------------------------------------------------------
To post to this group, send email to excel-macros@googlegroups.com
To unsubscribe, send a blank email to excel-macros+unsubscr...@googlegroups.com
