Excel VBA: Rowdata into correct Column for Access Import

[rccline]

I import into excel from a webdatabase with copy-paste and get the following type of structure

Column1 Column2
Name John Jones
Address: 234 Main Street, Houston, Texas 77488
Comment: I am lost
blank row
blank row
blank row
Name John Jones
Address 1234 Long Street, Houston, Texas 77488
Comment I am not lost
blank row
blank row
blank row
Name John Jones
Address 2340 Short Street, Houston, Texas 77488
Comment Everyone is lost



Question: How do I import this data into Access?

The groups are separated by 3 empty rows. I can't figure out how to place the mixed data in the columns into discrete columns representing respective fields so I can import into Access?

Thanks.

Robert

 

[kphu]

The first thing you'll need to do is to organize the data like this.

Name Address Comment
John Jones 234 main St... I am lost
John Jones 1234 Long St... I am not lost

Create a table in access with the fields: Name Address, City, State, Zip, Comment.

For address I would recommnd breaking out the data into seperate fields example Address, City, State, Zip. This will give you an advantage in the long run if you ever wanted to create queries based on state or city or whatever, but it'll create a little more work right now.

Now for the tedious part.

Create a macro (vb code) that will organize the data for you in excel.

here's the code - not tested.

I assumed that column1 above is "A" and column2 from above is "B"

sub organize()
dim i as integer
dim r as range
dim a, b, t as string
Set r = Intersect(ActiveSheet.UsedRange, Range("a8:a65536"))

application.screenupdating = false
worksheets(2).activate
range(“a1”).select
activecell.formula = “Name”
range(“b1”).select
activecell.formula = “Address”
range(“c1”).select
activecell.formula = “City”
range(“d1”).select
activecell.formula = “State”
range(“e1”).select
activecell.formula = “Zip”
range(“f1”).select
activecell.formula = “Comments”

worksheets(1).activate

for i = 1 to r.count
r.cells(i).select
t = r.cells(i).offset(0,1).value
select case activecell.value
case Name
worksheets(2).activate
range(“a65536”).select
selection.end(xlup).select
activecell.offset(1,0).select
activecell.formula = t
worksheets(1).select
case Address
worksheets(2).activate
range(“g65536”).select
selection.end(xlup).select
activecell.offset(1,0).select
b = activecell.address(false, false)
a = range(b).value
activecell.formula = t

range(“b65536”).select
selection.end(xlup).select
activecell.offset(1,0).select
activecell.Formula = “=MID(a,1,SEARCH(",",a,1)-1)”

range(“c65536”).select
selection.end(xlup).select
activecell.offset(1,0).select
activecell.Formula = “=MID(a,SEARCH(",",a,1)+2,SEARCH(",",a,SEARCH(",",a,1)+1)-SEARCH(",",a,1)-2)”
range(“d65536”).select
selection.end(xlup).select
activecell.offset(1,0).select
activecell.Formula = “=MID(a,SEARCH(",",a,SEARCH(",",a,1)+1)+2,LEN(a)-SEARCH(",",a,SEARCH(",",a,1)+1)-6)”

range(“e65536”).select
selection.end(xlup).select
activecell.offset(1,0).select
activecell.Formula = “=RIGHT(a,5)”

range(“a65536”).select
selection.end(xlup).select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

worksheets(1).select

Case Comment
Worksheets(2).activate
range(“F65536”).select
selection.end(xlup).select
activecell.offset(1,0).select
activecell.Formula = t

Case else

Next i

End sub

Merry Xmas

Ke

 

[kphu]

oops, saw a small error in my code.

Where it says case else.

put in "end select" after it

so n between case else and next i.

 

[rccline]

Your assumption was correct. However, the code breaks down at “=MID(a,1,SEARCH(",",a,1)-1)”
With the message: "Compile Error: Syntax Error"

I am totally lost trying to understand that.

Would it be easier to try and create the VBA code in Access?

Thanks.

Robert

 

[kphu]

this is tested.

Should work with no problems.

Merry XMAS I'm blowing outta this pop stand.

Sub organize()
Dim i As Integer
Dim r As Range
Dim b, c, t As String
Set r = Intersect(ActiveSheet.UsedRange, Range("a8:a65536"))
c = ""","""
Application.ScreenUpdating = False
Worksheets(2).Activate
Range("a1").Select
ActiveCell.Formula = "Name"
Range("b1").Select
ActiveCell.Formula = "Address"
Range("c1").Select
ActiveCell.Formula = "City"
Range("d1").Select
ActiveCell.Formula = "State"
Range("e1").Select
ActiveCell.Formula = "Zip"
Range("f1").Select
ActiveCell.Formula = "Comments"

Worksheets(1).Activate

For i = 1 To r.Count
r.Cells(i).Select
t = r.Cells(i).Offset(0, 1).Value
Select Case ActiveCell.Value
Case "Name"
Worksheets(2).Activate
Range("a65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Formula = t
Worksheets(1).Select
Case "Address"
Worksheets(2).Activate
Range("g65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
b = ActiveCell.Address(False, False)
ActiveCell.Formula = t
Range("b65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Formula = "=MID(" & b & ",1,SEARCH(" & c & "," & b & ",1)-1)"

Range("c65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Formula = "=MID(" & b & ",SEARCH(" & c & "," & b & ",1)+2,SEARCH(" & c & "," & b & ",SEARCH(" & c & "," & b & ",1)+1)-SEARCH(" & c & "," & b & ",1)-2)"
Range("d65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Formula = "=MID(" & b & ",SEARCH(" & c & "," & b & ",SEARCH(" & c & "," & b & ",1)+1)+2,LEN(" & b & ")-SEARCH(" & c & "," & b & ",SEARCH(" & c & "," & b & ",1)+1)-6)"

Range("e65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Formula = "=RIGHT(" & b & ",5)"

Range("a65536").Select
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Worksheets(1).Select

Case "Comment"
Worksheets(2).Activate
Range("F65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Formula = t
Worksheets(1).Activate
Case Else

End Select

Next i

End Sub