PDA

View Full Version : Search text



ditzah
05-27-2011, 01:34 AM
Hello all.

I did google a lot for this but I'm not sure I'm looking for the right terms...
Here's the thing. I have some text that's layed out like this:


Cod Nume
AB
CUI/CNP
77
Numar cont
RO
Nume banca
BA
Sucursala banca
SU
Cod banca
33

Cod Nume
AC
CUI/CNP
63
Numar cont
RO
Nume banca
BA
Sucursala banca
SU
Cod banca
30

Cod Nume
AC
CUI/CNP
11
Numar cont
RO
Nume banca
UN
Sucursala banca
SU
Cod banca
30

Cod Nume
VM
Numar cont
RO
Nume banca
BA
Sucursala banca
SU
Cod banca
30

I want to search through all this and lay the information in a table, something like this:


Cod Nume CUI/CNP Numar cont Nume banca Sucursala banca Cod banca
AB 77 RO BA SU 33
AC 63 RO BA SU 30
AC 11 RO UN SU 30
VM x RO BA SU 30

...and all the others.

The thing is that it doesn't have a definite pattern.. it varies a little. Some have 10 rows, some only 8 (missing the CUI/CNP)...
How can I do this?
Do you have any ideas? I don't need the whole code, but a least some ideas to what to look for...

Bob Phillips
05-27-2011, 01:46 AM
Public Sub ProcessData()
Dim this As Worksheet
Dim sh As Worksheet
Dim Lastrow As Long
Dim Nextrow As Long
Dim col As Long
Dim i As Long

Application.ScreenUpdating = False

Set this = ActiveSheet
Set sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
sh.Range("A1:F1").Value = Array("Cod Nume", "CUI/CNP", "Numar cont", "Nume banca", "Sucursala banca", "Cod banca")
With this

Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Nextrow = 1
For i = 1 To Lastrow 'Lastrow to 1 Step -1

If .Cells(i, "A").Value2 <> "" Then

col = 0
On Error Resume Next
col = Application.Match(.Cells(i, "A").Value2, sh.Rows(1), 0)
On Error GoTo 0
If col <> 0 Then

If col = 1 Then Nextrow = Nextrow + 1
.Cells(i + 1, "A").Copy sh.Cells(Nextrow, col)
i = i + 1
End If
End If
Next i
End With

Application.ScreenUpdating = True
End Sub

ditzah
05-27-2011, 02:38 AM
Muchas gracias, seņor!
Wow, that was fast!

It worked like a charm, on the first run.
Thank you!

ditzah
05-30-2011, 02:05 AM
OK, so I have a similar issue now, only that this time the pattern is even more screwed up.



Cod Nume Adresa SWIFT
AAR
7 R
F49
Numar cont
FR7
Adresa banca
CRE
ST
FRA

Cod Nume Adresa SWIFT
ABS
28
446
Numar cont
FR7
Adresa banca
BAN
FRA


So I adapted the code, and it's working, but it's picking up only the first cell after the header item (ie. Numar cont)... how do I make it pick up all rows, until the next item, separated by a coma, in one single cell, like this?


Cod Nume Adresa SWIFT | Numar cont | Adresa banca
AAR, 7 R, F49 | FR7 | CRE, ST , FRA
ABS, 28 , 446 | FR7 | BAN, FRA

There can be 1 to 4 rows after each header item.
Thanks a bunch.:bow:

Bob Phillips
05-30-2011, 02:17 AM
Post a workbook with your adapted code.

ditzah
05-30-2011, 06:15 AM
Oh, I just changed the line defining the header like this:
sh.Range("A1:C1").Value = Array("Cod Nume Adresa SWIFT ", "Numar cont ", "Adresa banca ")

Bob Phillips
05-30-2011, 11:40 PM
So you have a completely different requirement and you think all that needs is new headings?

This is much more complicated



Option Explicit

Public Sub ProcessData()
Dim this As Worksheet
Dim sh As Worksheet
Dim First As Boolean
Dim Lastrow As Long
Dim Nextrow As Long
Dim col As Long, prevCol As Long
Dim i As Long

Application.ScreenUpdating = False

Set this = ActiveSheet
Set sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
sh.Range("A1:C1").Value = Array("Cod Nume Adresa SWIFT", "Numar cont", "Adresa banca")
With this

Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Nextrow = 1
For i = 1 To Lastrow 'Lastrow to 1 Step -1

If .Cells(i, "A").Value2 <> "" Then

col = 0
On Error Resume Next
col = Application.Match(.Cells(i, "A").Value2, sh.Rows(1), 0)
On Error GoTo 0
If col <> 0 Then

If col = 1 Then Nextrow = Nextrow + 1
prevCol = col
First = True

Do

i = i + 1

col = 0
On Error Resume Next
col = Application.Match(.Cells(i, "A").Value2, sh.Rows(1), 0)
On Error GoTo 0

If col = 0 Then

If First Then

sh.Cells(Nextrow, prevCol).Value2 = sh.Cells(Nextrow, prevCol).Value2 & .Cells(i, "A").Value2
First = False
Else

sh.Cells(Nextrow, prevCol).Value2 = sh.Cells(Nextrow, prevCol).Value2 & "," & .Cells(i, "A").Value2
End If
Else

prevCol = col
i = i - 1
End If
Loop Until col <> 0 Or .Cells(i, "A").Value2 = ""
End If
End If
Next i
End With

Application.ScreenUpdating = True
End Sub

ditzah
05-31-2011, 02:39 AM
Hey, thanks a lot, man.
At first, it was OK only with that first line the code was picking up, but then the demands got higher :P

Again, thank you.

I think you really are a Distinguished Lord of VBAX :bow: