Need to copy address to next sheet in a database manner

[rajkumar]

Hi experts,

I need to copy a list of addresses imported from a text file to next worksheet in a data base fashion. i tried to write some code for the same, but could not, can anyone help me . i have attached the sample workbook herewith.

please help.

raj14498

[p45cal]

Looking at your database you have some odd data, namely dates appearing; for example cells A2670, A3451, A3458 among 62 such cells. This is probably due to how you imported the data from the file RD.TXT. When you get to the Text Import Wizard dialog, in the 3rd step, make sure that all 3 column formats are Text, otherwise Excel will try to interpret what looks like it might be a date into a real Excel date.
Once that's done you can run this (messy) code which works in your attached file:
Sub blah()
Dim PC As Range
Application.ScreenUpdating = False
On Error GoTo handler
destnrow = 2
With Sheets("Main")
For colm = 1 To 3
Set xxx = .Cells(.Rows.Count, colm).End(xlUp)
LR = xxx.Row
Set xxx = .Columns(colm).Find(What:="DM-*", After:=xxx, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Do
Set oldxxx = xxx
Set xxx = .Columns(colm).Find(What:="DM-*", After:=xxx, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Z = xxx.Row - oldxxx.Row
If Z < 0 Then Set xxx = .Cells(LR + 1, colm)
Set PC = .Range(oldxxx, xxx.Offset(-1)).Find("*PIN CODE*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If PC Is Nothing Then
.Range(oldxxx, xxx.Offset(-1)).Copy
Sheets("Database").Cells(destnrow, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Else
.Range(oldxxx, PC.Offset(-1)).Copy
Sheets("Database").Cells(destnrow, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
PC.Copy Sheets("Database").Cells(destnrow, 7)
End If
destnrow = destnrow + 1
Loop Until xxx.Row >= LR
Next colm
End With
handler:
Application.ScreenUpdating = True
End Sub

[rajkumar]

Wow, Works perfect . Thanks for your great help!:friends:
Raj