Data Concatenation- Guna

[guna_sekar87]

Dear Chandoo,


I am Gunasekaran B. I attended your Excel Training Program.

Now, I have an issue in my work. The work is very much time consuming.

So, please guide me to create a Macro tool for this automation.

Input : Coloumn A

1 DTC 0001h

2 72h

3 73h

4 98h


1) Remove the text “DTC” from “DTC 0001h” and get 0001


2) Concatenate 0001 with 72h and remove “h”


3) Concatenate 0001 with 73h and remove “h”


4) Concatenate 0001 with 98h and remove “h”


Final output :

Coloumn A

1 000172

2 000173

3 000198


The Point to remember here is, The Input Data is not continuous. It has blank cell in between.


1)If there is blank cell, ”outside the DTC”, I should delete that(11,12,13,14 cell of coloum A).


Therefore, I should start with “DTC” and do the 4 steps till I reach other “DTC” and I should delete the blank cells in between till the reach the other DTC.


Input :

Coloumn A

1 DTC 0001h

2 72h

3 73h

4 98h

5 DTC 0002h

6 23h

7 24h

8 91h

9 F5h

10F6h

11

12

13

14

15DTC 0016h

16 62h


Final output :


1 000172

2 000173

3 000198

4 000223

5 000224

6 000291

7 0002F5

8 0002F6

9 001662


2) If there is blank cell, ”inside the DTC”, I should delete (cell 2,5 of coloumn A)that also.


Input :


Coloumn A

1 DTC 0340h

2

3 31h

4 64h

5

6 DTC 0380h

7 11h

8 12h

9 13h

10 96h

11 98h


Output :

Coloumn A

1 034031

2 034064

3 038011

4 038012

5 038013

6 038096

7 038098


Kindly, do the needful. Waiting for your valuable reply.


Regards,

Gunasekaran

 

[Luke M]

How's this? Takes everything in col A and reduced is down. Note that output is in text format to maintain any leading zeros.

[pre]

Sub ShortenList()
Dim fString As String
Dim newString As String
Dim lString As String
Dim sRange As Range
Dim c As Range
Dim i As Long
Dim x As Long
'Define what our flag value is
Const tag = "DTC "

'Starting output row
i = 1
'Output column
x = 1

'Change as needed. Could refer to a set range. instead
Set sRange = Range("A1", Cells(Cells.Rows.Count, "A").End(xlUp))

'Format cells to text to maintain leading zero
Cells(1, x).EntireColumn.NumberFormat = "@"

Application.ScreenUpdating = False
For Each c In sRange
lString = c.Value
If InStr(lString, tag) > 0 Then
fString = Mid(lString, Len(tag) + 1, Len(lString) - Len(tag) - 1)
ElseIf lString <> "" Then
newString = fString & Left(lString, Len(lString) - 1)
Cells(i, x) = newString
i = i + 1
End If
c.ClearContents
Next c
Application.ScreenUpdating = True

End Sub

[/pre]

 

[Montrey]

Is screen updating = auto calculate?

How does VBA know what to do with the "C" Range?

Only thing I see that says what it is, is the Dim C as Range.

How does VBA know what range of cells it is referring too?


If you define something as a range and don't specificly define the range, does VBA just make its' own ranges?

 

[Luke M]

Hi Montrey!


Screen updating is XL taking the time to refresh what is actually being displayed on the monitor. By disabling this, the prorram can run faster (not taking time to refresh) and the user is not blasted with lots of images flashing across screen.


c is defined as a range at top, as you notice. The next key line is

For each c in sRange


Since I've already stated that c is a range, VB knows that I want to look at each "range" within the overall range, aka, each cell within the larger range. Alternatively, I could leave c undefined and VB would read it as "for each [b]thing[/b] in sRange..." and would probably be able to figure out that I want to look at a cell/range.


Another example is this:

For each ws in ThisWorkbook.Worksheets

I don't "have" to define that a ws is a worksheet, since the only things within the Worksheets group are worksheets, but it's generally good practice to define all your variables.


Hope that helps, or have I just created more questions?

 

[Montrey]

ahhhh makes sense now. Very clear and Concise

Thanks Luke.

 

[Luke M]

No worries, glad I was able to explain. =)

 

[guna_sekar87]

Hi Luke,


Thanks for your macro code. This is working very well.


I am new to learning of macro tool. Kindly explain me the important points or lesson to be remember in this coding.


and also while i use this coding, when i run the macro second time data is shortened by one digit, when i run at third time, whole data is lost. so, is there any way to show the user message if he runs the macro after first time.

 

[Luke M]

I've tried to add comments to everything to explain. To prevent data loss, I'd probably recommend just changing the output column to a different column (say, col 2?) and removing the clear contents command. That way, after macro is run, you end up with the desired output, but original data is still intact.

[pre]

Sub ShortenList()
'First, we define all the variables that we are going to us
'This isn't a requirement in VBA, but it's good practice
'and it helps on performance
Dim fString As String
Dim newString As String
Dim lString As String
Dim sRange As Range
Dim c As Range
Dim i As Long
Dim x As Long

'Define what our flag value is
Const tag = "DTC "

'Starting output row
i = 1
'Output column
x = 1

'Change as needed. Could refer to a set range instead
'The last part of this is saying to start at cell A65536 (or whatever last
'cell in col A is) and then go up until you find "something"
'This sets the size of our range to look at
Set sRange = Range("A1", Cells(Cells.Rows.Count, "A").End(xlUp))

'Format cells to text to maintain leading zero
Cells(1, x).EntireColumn.NumberFormat = "@"

'As explained to Montrey, we turn this off to speed up performance
'and prevent screen flashing
Application.ScreenUpdating = False

'For each cell in our range...
For Each c In sRange

'Set the value of cell to a variable so we don't have to
'keep looking at the cell. Also, we're going to clear cell contents,
'so we need to save this for later
lString = c.Value
If InStr(lString, tag) > 0 Then 'If the tag word is In the String of...
'extract the first part of string using MID function.
'We start 1 after the Tag word, and subtract 1 since we
'don't want the final letter H
fString = Mid(lString, Len(tag) + 1, Len(lString) - Len(tag) - 1)
ElseIf lString <> "" Then 'Not a tag word cell...

'Create new word using last saved fString and the first part of
'this cells's word
newString = fString & Left(lString, Len(lString) - 1)

'Write our new word to a cell
Cells(i, x) = newString

'Increment value so next time we'll write to the next row
i = i + 1
End If

'Clear the cell's contents
c.ClearContents
Next c

'Don't always "have" to turn this back on, but it's good practice
Application.ScreenUpdating = True

End Sub

[/pre]