formatting question

[lmutemple]

i pulled a large file over from another work database and the formatting brings the list over so it is all in one column underneath each other like this:

name
skip line
title
skip line
company name
skip line
location
skip line and start all over again.

i want the format to be:
column a (name), column b(title), column c(company name) column d (location)

any ideas, tricks, solutions?

 

[sachavez]

what is the name of the tab where your data exists?

Where do you want to put your clean / organized data?

 

[sachavez]

Here is some code that should work. Here are some guidelines to follow:

1. Make a back-up copy of your data. There's no "undo" button with VBA code.

2. This code assumes your working data is in Sheet1 (if not, you will need to rename your data sheet as Sheet1).

3. The clean data will be placed in Sheet2. Make sure you have a sheet2, and that it is empty prior to executing the code.

4. YOU MUST SELECT ALL OF YOUR ROWS IN SHEET1 PRIOR TO EXECUTING THE MACRO.

This is my first "real" VBA program, so there are no guarantees.

Sub CleanData()
'
Application.ScreenUpdating = False

Dim i As Long
Dim x As Integer

'Add header names to organized data sheet
Sheets("Sheet2").Select
Range("A1") = "Name"
Range("B1") = "Title"
Range("C1") = "Company"
Range("D1") = "Location"
Range("A1:D1").Font.Bold = True


'Cleanup original datasheet

Sheets("Sheet1").Select

For i = Selection.Rows.Count To 1 Step -1

If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If

Next i


'Move data from original sheet to organized data sheet

Numrows = Range("A1", Range("A1").End(xlDown)).Rows.Count
For x = 1 To Numrows

Range("A1:A4").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1048548").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Sheet1").Select
Rows("1:4").Delete

Next
Sheets("Sheet2").Select
Columns.AutoFit

Application.ScreenUpdating = True

End Sub

 

[sachavez]

Re-posting with code tags (hopefully they work)

Sub CleanData()
'
    Application.ScreenUpdating = False
    
    Dim i As Long
    Dim x As Integer

'Add header names to organized data sheet
    Sheets("Sheet2").Select
    Range("A1") = "Name"
    Range("B1") = "Title"
    Range("C1") = "Company"
    Range("D1") = "Location"
    Range("A1:D1").Font.Bold = True
    
    
'Cleanup original datasheet

Sheets("Sheet1").Select

    For i = Selection.Rows.Count To 1 Step -1
    
        If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
            Selection.Rows(i).EntireRow.Delete
        End If
        
    Next i
    
    
'Move data from original sheet to organized data sheet

    Numrows = Range("A1", Range("A1").End(xlDown)).Rows.Count
    For x = 1 To Numrows
            
        Range("A1:A4").Select
        Selection.Copy
        Sheets("Sheet2").Select
        Range("A1048548").Select
        Selection.End(xlUp).Select
        ActiveCell.Offset(1, 0).Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        Sheets("Sheet1").Select
        Rows("1:4").Delete
    
    Next
        Sheets("Sheet2").Select
        Columns.AutoFit
        
    Application.ScreenUpdating = True
       
End Sub

 

[sulakvea]

hi lmutemple,

i would go with sachavez's solution if you have way too many rows and formulas may freeze. but here's a formula approach, just in case. assumes original data sits in Col A:

B1 =INDEX(A:A,(ROW()-1)*8+1) - name
C1 =INDEX(A:A,(ROW()-1)*8+3) - title
D1 =INDEX(A:A,(ROW()-1)*8+5) - company
E1 =INDEX(A:A,(ROW()-1)*8+7) - location

and copy the whole thing down until you start seeing zero's - that means the formulas reached the end of the list.