I've made a couple of modifications.
This actually should work for both files.
Please note that I created a new variable: Col_Data
also changed the range that is replaced to: Columns("B:C").Select
'==============================================
Please keep in mind that many of the members of groups such as these
do progamming
like this for a LIVING.
We don't mind helping out fellow programmers and even people just
starting out,
but doing complete jobs start-to-finish for free isn't in our best
interest, and keeps us from
doing our "real" jobs.
'==============================================
Option Explicit
Sub Traspose_Data()
Dim Rcnt, RowInx, inx, phArray, phArray2, phInx, phInx2, CName
Dim Sht_IN, Sht_OUT, Col_Data
Dim RngBegin, RngEnd
'------------------------------------------------------
Sht_IN = "Main"
Sht_OUT = "working"
'------------------------------------------------------
Sheets(Sht_IN).Select
Columns("B:C").Select
Selection.Replace What:=",", Replacement:=";", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False
Selection.Replace What:=";;", Replacement:=";", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False
Range("A2").Select
Sheets(Sht_OUT).Range("A2:Z65000").ClearContents
'------------------------------------------------------
' Count the number of rows in "Main" sheet
'------------------------------------------------------
Rcnt =
Application.WorksheetFunction.CountA(Sheets(Sht_IN).Range("A1:A65000"))
RowInx = 1
'------------------------------------------------------
' Loop through all data rows
'------------------------------------------------------
For inx = 2 To Rcnt
If (Sheets(Sht_IN).Cells(inx, 1).Value <> "") Then
CName = Sheets(Sht_IN).Cells(inx, 1).Value
'------------------------------------------------------
' split dial codes using "," as delimter and store in
array
'------------------------------------------------------
If (Sheets(Sht_IN).Cells(inx, 3).Value = "") Then
Col_Data = 2
Else
Col_Data = 3
End If
phArray = Split(Sheets(Sht_IN).Cells(inx, Col_Data).Value,
";")
'------------------------------------------------------
' Loop through array
'------------------------------------------------------
For phInx = 0 To UBound(phArray)
If (InStr(1, phArray(phInx), "-") > 0) Then
phArray2 = Split(phArray(phInx), "-")
For phInx2 = phArray2(0) To phArray2(1)
RowInx = RowInx + 1
Sheets(Sht_OUT).Cells(RowInx, 1) = CName
Sheets(Sht_OUT).Cells(RowInx, 2) = phInx2
Next phInx2
Else
RowInx = RowInx + 1
Sheets(Sht_OUT).Cells(RowInx, 1) = CName
Sheets(Sht_OUT).Cells(RowInx, 2) = phArray(phInx)
End If
Next phInx
End If
Next inx
'----------------------------------------
' Sort Data
'----------------------------------------
Sheets(Sht_OUT).Select
Cells.Select
ActiveWorkbook.Worksheets(Sht_OUT).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(Sht_OUT).Sort.SortFields.Add
Key:=Range( _
"A2:A65000"), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets(Sht_OUT).Sort.SortFields.Add
Key:=Range( _
"B2:B65000"), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(Sht_OUT).Sort
.SetRange Range("A1:B65000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2").Select
End Sub
--------------------------------------------------------------------------------
From: girish kumar <girishkumar832...@gmail.com>
To: Paul Schreiner <schreiner_p...@att.net>
Sent: Mon, August 16, 2010 10:50:53 AM
Subject: Fwd: Fwd: $$Excel-Macros$$ help required
Hi Paul,
yes 2 different macros, one macro already u have gave me for single
column dial codes
i want another macro for 2 column codes
where city code column is blank there it should take only country code
where city code is given there it transpose codes like first macro u
have given to me and concatenate all codes with country code rest all
the procedures are same as previous macro.
i m very much interested in VBA, i m planning to join VBA course also.
pls. dont miss understand me, your macro finishing my normalise work
with in one minute
otherwise it will take more than one hour to normalise it we have to
split the code if codes length more than 2000.
but your Macro makes it very simple.
thanks in advance
Girish.
On Mon, Aug 16, 2010 at 7:35 PM, Paul Schreiner
<schreiner_p...@att.net> wrote:
hmm... so, are you trying to LEARN the VBA portion or
are you just getting me to do it for you?
are you wanting two different macros? or one macro that will
read the header and figure out what to do?
as far as that goes, you could just duplicate the loop portion of
the code and have it run on both columns.
--------------------------------------------------------------------------------
From: girish kumar <girishkumar832...@gmail.com>
To: Paul Schreiner <schreiner_p...@att.net>
Sent: Mon, August 16, 2010 8:31:02 AM
Subject: Re: Fwd: $$Excel-Macros$$ help required
Hi Paul,
This is our daily routine work, we are receiving daily plenty of rate
agreements for different carriers, and we have one software also for
normalize the file, but having so many limitations and taking too much
time also
we are receiving 2 types of codes list
format 1 : that u already provided me macro which having county code
and dial codes concatenated
format 2: which file having country and dial code in different
columns, but out put i want same as format 1
i know only record macro, about VBA im not aware that much.
On Mon, Aug 16, 2010 at 5:33 PM, Paul Schreiner
<schreiner_p...@att.net> wrote:
Sorry...
since this came from you instead of the group, my email put it in the
SPAM folder.
are you doing any of this yourself? or just having me do your job for
you?
are you saying that if there are no "dial codes", you want just the
"country code" in the working sheet?
what about the other job this was designed for?
does it have to work for both cases? or is this the new format?
Paul
--------------------------------------------------------------------------------
From: girish kumar <girishkumar832...@gmail.com>
To: Paul Schreiner <schreiner_p...@att.net>
Cc: excel-macros@googlegroups.com
Sent: Mon, August 16, 2010 2:35:00 AM
Subject: Fwd: $$Excel-Macros$$ help required
Hi Paul,
i have made some changes in sheet, in some palce only contry code is
there and then dial code are blank then also it should be normalise as
per attached sheet.
thanks in advance
Girish.
---------- Forwarded message ----------
From: girish kumar <girishkumar832...@gmail.com>
Hi Paul,
any updates for attached sheet
---------- Forwarded message ----------
From: girish kumar <girishkumar832...@gmail.com>
Date: Sat, Aug 14, 2010 at 7:39 PM
Subject: Fwd: $$Excel-Macros$$ help required
To: Paul Schreiner <schreiner_p...@att.net>
Hi Paul,
any updates??
---------- Forwarded message ----------
From: girish kumar <girishkumar832...@gmail.com>
Hi Paul
this works great,
I have another set of sheet, procedure is same, but dial codes format
is change
means country code and destinations codes are different columns
i want after running macro it should be concatenate and normalize
see attached file
thanks in advance
Girish
On Sat, Aug 14, 2010 at 2:34 AM, Paul Schreiner
<schreiner_p...@att.net> wrote:
The problem is NOT that it is not removing the ; or , properly.
The problem is that there is only one of them in the string
(two numbers separated by a "," or ";")
when I change it to a ",", Excel "assumes" that it is a big number
as if: 123,456 is 123 thousand, 456.
So instead, I changed all of the "," to ";",
THEN Excel assumes they're all text strings.
give it a try:
Paul
--------------------------------------------------------------------------------
From: girish kumar <girishkumar832...@gmail.com>
To: Paul Schreiner <schreiner_p...@att.net>
Cc: excel-macros@googlegroups.com
Sent: Fri, August 13, 2010 2:23:49 PM
Subject: Fwd: $$Excel-Macros$$ help required
Hi Paul
any updates??
---------- Forwarded message ----------
From: girish kumar <girishkumar832...@gmail.com>
Date: Fri, Aug 13, 2010 at 8:21 PM
Subject: Re: $$Excel-Macros$$ help required
To: Paul Schreiner <schreiner_p...@att.net>
Cc: excel-macros@googlegroups.com
Hi Paul,
i tried, for - its working
but for ; its not replacing i think, it just removing "," & make add
2 dial codes together
see attached file
Thanks in advance. salute for your knowledge
Regards
Girish
Tata Communications.
On Fri, Aug 13, 2010 at 7:53 PM, Paul Schreiner
<schreiner_p...@att.net> wrote:
What I would do first is add this to your code:
Columns("B:B").Select
Selection.Replace What:=";", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False
Selection.Replace What:=",,", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False
Range("A2").Select
It will replace all ";" with ",", then remove any spaces and replace
any
doubles ",," with ",".
As for the ranges,
are they completely numeric?
If so, we can create another loop to process the sequence.
I ended up with:
Option Explicit
Sub Traspose_Data()
Dim Rcnt, RowInx, inx, phArray, phArray2, phInx, phInx2, CName
Dim Sht_IN, Sht_OUT
Dim RngBegin, RngEnd
'------------------------------------------------------
Sht_IN = "Main"
Sht_OUT = "working"
'------------------------------------------------------
Sheets(Sht_IN).Select
Columns("B:B").Replace What:=";", Replacement:=",",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False
Columns("B:B").Replace What:=" ", Replacement:="",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False
Columns("B:B").Replace What:=",,", Replacement:=",",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False
Range("A2").Select
Sheets(Sht_OUT).Range("A2:Z65000").ClearContents
'------------------------------------------------------
' Count the number of rows in "Main" sheet
'------------------------------------------------------
Rcnt =
Application.WorksheetFunction.CountA(Sheets(Sht_IN).Range("A1:A65000"))
RowInx = 1
'------------------------------------------------------
' Loop through all data rows
'------------------------------------------------------
For inx = 2 To Rcnt
If (Sheets(Sht_IN).Cells(inx, 1).Value <> "") Then
CName = Sheets(Sht_IN).Cells(inx, 1).Value
'------------------------------------------------------
' split dial codes using "," as delimter and store in
array
'------------------------------------------------------
phArray = Split(Sheets(Sht_IN).Cells(inx, 2).Value, ",")
'------------------------------------------------------
' Loop through array
'------------------------------------------------------
For phInx = 0 To UBound(phArray)
If (InStr(1, phArray(phInx), "-") > 0) Then
phArray2 = Split(phArray(phInx), "-")
For phInx2 = phArray2(0) To phArray2(1)
RowInx = RowInx + 1
Sheets(Sht_OUT).Cells(RowInx, 1) = CName
Sheets(Sht_OUT).Cells(RowInx, 2) = phInx2
Next phInx2
Else
RowInx = RowInx + 1
Sheets(Sht_OUT).Cells(RowInx, 1) = CName
Sheets(Sht_OUT).Cells(RowInx, 2) = phArray(phInx)
End If
Next phInx
End If
Next inx
'----------------------------------------
' Sort Data
'----------------------------------------
Sheets(Sht_OUT).Select
Cells.Select
ActiveWorkbook.Worksheets(Sht_OUT).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(Sht_OUT).Sort.SortFields.Add
Key:=Range( _
"A2:A65000"), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets(Sht_OUT).Sort.SortFields.Add
Key:=Range( _
"B2:B65000"), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(Sht_OUT).Sort
.SetRange Range("A1:B65000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2").Select
End Sub
--------------------------------------------------------------------------------
From: girish kumar <girishkumar832...@gmail.com>
To: excel-macros@googlegroups.com
Cc: schreiner_p...@att.net
Sent: Fri, August 13, 2010 9:26:53 AM
Subject: Re: $$Excel-Macros$$ help required
Hi Paul
wonderfull, its working....
thanks friend, i want some more help from u for same file.
this macro u provided me text column using ,
but some times i ll get , ; both
and number's like 9321-9325 this should be
9321
9322
9323
9324
can add these on same macro and send me back
thanks in advance
On Fri, Aug 13, 2010 at 5:23 PM, Paul Schreiner
<schreiner_p...@att.net> wrote:
Is this something you have to do frequently?
I was able to do it manually in 5 minutes by using Text-to-Columns
then copy/paste special, transform
to get it into column form, then copied the carrier
name down each column and move it into the first pair of columns.
But if you do it frequently, it can be tedious.
this macro should do it for you:
Option Explicit
Sub Traspose_Data()
Dim Rcnt, RowInx, inx, phArray, phInx, CName
Dim Sht_IN, Sht_OUT
'------------------------------------------------------
Sht_IN = "Main"
Sht_OUT = "working"
'------------------------------------------------------
Sheets(Sht_IN).Select
Sheets(Sht_OUT).Range("A2:Z65000").ClearContents
'------------------------------------------------------
' Count the number of rows in "Main" sheet
'------------------------------------------------------
Rcnt =
Application.WorksheetFunction.CountA(Sheets(Sht_IN).Range("A1:A65000"))
RowInx = 1
'------------------------------------------------------
' Loop through all data rows
'------------------------------------------------------
For inx = 2 To Rcnt
If (Sheets(Sht_IN).Cells(inx, 1).Value <> "") Then
CName = Sheets(Sht_IN).Cells(inx, 1).Value
'------------------------------------------------------
' split dial codes using "," as delimter and store in
array
'------------------------------------------------------
phArray = Split(Sheets(Sht_IN).Cells(inx, 2).Value, ",")
'------------------------------------------------------
' Loop through array
'------------------------------------------------------
For phInx = 0 To UBound(phArray)
RowInx = RowInx + 1
Sheets(Sht_OUT).Cells(RowInx, 1) = CName
Sheets(Sht_OUT).Cells(RowInx, 2) = phArray(phInx)
Next phInx
End If
Next inx
'----------------------------------------
' Sort Data
'----------------------------------------
Sheets(Sht_OUT).Select
Cells.Select
ActiveWorkbook.Worksheets(Sht_OUT).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(Sht_OUT).Sort.SortFields.Add
Key:=Range( _
"A2:A65000"), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets(Sht_OUT).Sort.SortFields.Add
Key:=Range( _
"B2:B65000"), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(Sht_OUT).Sort
.SetRange Range("A1:B65000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2").Select
End Sub
Paul
--------------------------------------------------------------------------------
From: girish kumar <girishkumar832...@gmail.com>
To: excel-macros@googlegroups.com
Sent: Fri, August 13, 2010 5:13:14 AM
Subject: $$Excel-Macros$$ help required
can any one help me to sort out this problem
i have attached one file contains 2 sheets
in first sheet having main data, i want this data like data in working
sheet in normalised formet
friends pls set vba macro or access database for sort out this problem
regards
Girish
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 7000 subscribers worldwide and receive many nice notes about the
learning and support from the group.Let friends and co-workers know they can
subscribe to group at http://groups.google.com/group/excel-macros/subscribe
