Put Data in Database Format

[pto160]

I have data that is not organized in a database format. I am trying to change it into a database format.
I need to pick up specific information between dates and put that information on one row for that date. I am not interested in trans ID. All the dates might not contain this information.
Sheet1

<table style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial,Arial; FONT-SIZE: 10pt" border="1" cellpadding="0" cellspacing="0"> <colgroup> <col style="WIDTH: 30px; FONT-WEIGHT: bold"> <col style="WIDTH: 64px"> <col style="WIDTH: 64px"> <col style="WIDTH: 64px"> <col style="WIDTH: 64px"></colgroup> <tbody> <tr style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"> <td> </td> <td>A</td> <td>B</td> <td>C</td> <td>D</td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">1</td> <td>Date</td> <td style="TEXT-ALIGN: right">7/15/2011</td> <td> </td> <td> </td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</td> <td> </td> <td> </td> <td>Type</td> <td>A</td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</td> <td> </td> <td> </td> <td>Amount</td> <td style="TEXT-ALIGN: right">100.00</td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</td> <td> </td> <td> </td> <td>Ref</td> <td>John Doe</td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</td> <td> </td> <td> </td> <td>Trans ID</td> <td style="TEXT-ALIGN: right">465465</td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</td> <td> </td> <td> </td> <td> </td> <td> </td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</td> <td> </td> <td> </td> <td> </td> <td> </td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</td> <td> </td> <td> </td> <td> </td> <td> </td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">9</td> <td>Date</td> <td style="TEXT-ALIGN: right">7/18/2011</td> <td> </td> <td> </td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">10</td> <td> </td> <td> </td> <td> </td> <td> </td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">11</td> <td> </td> <td> </td> <td>Type</td> <td>B</td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">12</td> <td> </td> <td> </td> <td>Amount</td> <td style="TEXT-ALIGN: right">200.00</td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">13</td> <td> </td> <td> </td> <td>Ref</td> <td>Mary Doe</td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">14</td> <td> </td> <td> </td> <td>Trans ID</td> <td style="TEXT-ALIGN: right">4646456</td></tr></tbody></table>

Excel tables to the web >> Excel Jeanie HTML 4

Solution:
Sheet1

<table style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial,Arial; FONT-SIZE: 10pt" border="1" cellpadding="0" cellspacing="0"> <colgroup> <col style="WIDTH: 30px; FONT-WEIGHT: bold"> <col style="WIDTH: 64px"> <col style="WIDTH: 64px"> <col style="WIDTH: 64px"> <col style="WIDTH: 64px"></colgroup> <tbody> <tr style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"> <td> </td> <td>B</td> <td>C</td> <td>D</td> <td>E</td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">17</td> <td> </td> <td>Type</td> <td>Amount</td> <td>Ref</td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">18</td> <td style="TEXT-ALIGN: right">7/15/2011</td> <td>A</td> <td style="TEXT-ALIGN: right">100.00</td> <td>Joe Doe</td></tr> <tr style="HEIGHT: 17px"> <td style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">19</td> <td style="TEXT-ALIGN: right">7/18/2011</td> <td>B</td> <td style="TEXT-ALIGN: right">200.00</td> <td>Mary Doe</td></tr></tbody></table>

Excel tables to the web >> Excel Jeanie HTML 4

How would you do this?

 

[hiker95]

pto160,


Be right back (formatting is not correct).

 

[hiker95]

pto160,


Sample raw data before the macro:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J
1	Date	7/15/2011
2			Type	A
3			Amount	100.00
4			Ref	John Doe
5			Trans ID	465465
6
7
8
9	Date	7/18/2011
10
11			Type	B
12			Amount	200
13			Ref	Mary Doe
14			Trans ID	4646456
15
Sheet1

After the macro:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J
1	Date	7/15/2011					Date	Type	Amount	Ref
2			Type	A			7/15/2011	A	100.00	John Doe
3			Amount	100.00			7/18/2011	B	200.00	Mary Doe
4			Ref	John Doe
5			Trans ID	465465
6
7
8
9	Date	7/18/2011
10
11			Type	B
12			Amount	200
13			Ref	Mary Doe
14			Trans ID	4646456
15
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub ReorgData()
' hiker95, 09/05/2011
' http://www.mrexcel.com/forum/showthread.php?t=576673
Dim AD(), G(), r As Long
Dim c As Range, firstaddress As String
Dim Area As Range, SR As Long, ER As Long, NR As Long
Application.ScreenUpdating = False
Columns("G:J").ClearContents
r = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row + 1
AD = Range("A1:D" & r)
Rows(1).Insert
With Columns(1)
  Set c = .Find("Date", LookIn:=xlValues, LookAt:=xlWhole)
  If Not c Is Nothing Then
    firstaddress = c.Address
    Do
      c.Offset(, 2) = "C"
      Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
  End If
End With
On Error Resume Next
Range("C1", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
For r = Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
  If Cells(r, 3) = "C" Then Rows(r).Insert
Next r
Range("G1:J1") = [{"Date","Type","Amount","Ref"}]
For Each Area In Range("C1", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With Area
    SR = .Row
    ER = SR + .Rows.Count - 1
    NR = Range("G" & Rows.Count).End(xlUp).Offset(1).Row
    Range("G" & NR) = Range("B" & SR)
    For r = SR + 1 To ER Step 1
      If InStr(Cells(r, 3), "Type") > 0 Then
        Range("H" & NR) = Cells(r, 4)
      ElseIf InStr(Cells(r, 3), "Amount") > 0 Then
        Range("I" & NR) = Cells(r, 4)
      ElseIf InStr(Cells(r, 3), "Ref") > 0 Then
        Range("J" & NR) = Cells(r, 4)
      End If
    Next r
  End With
Next Area
Range("G2:G" & NR).NumberFormat = "m/d/yyyy;@"
Range("I2:I" & NR).NumberFormat = "#,##0.00"
Columns("G:J").AutoFit
Range("A1:D" & UBound(AD)) = AD
Application.ScreenUpdating = True
End Sub

Then run the ReorgData macro.

 

[hiker95]

pto160,

I am learning how to use arrays to manipulate data in memory (much faster) instead of in worksheets.

Same screenshots as above, but faster.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Option Base 1
Sub ReorgDataV2()
' hiker95, 09/05/2011
' http://www.mrexcel.com/forum/showthread.php?t=576673
Dim I(), O(), r As Long, d As Long
Columns("G:J").ClearContents
d = Application.CountIf(Columns(1), "Date")
r = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
I = Range("A1:D" & r)
ReDim O(1 To d + 1, 1 To 4)
O(1, 1) = "Date"
O(1, 2) = "Type"
O(1, 3) = "Amount"
O(1, 4) = "Ref"
d = 1
For r = 1 To UBound(I)
  If I(r, 3) = "" And I(r, 1) = "Date" Then
    d = d + 1
    O(d, 1) = I(r, 2)
  ElseIf InStr(I(r, 3), "Type") > 0 Then
    O(d, 2) = I(r, 4)
  ElseIf InStr(I(r, 3), "Amount") > 0 Then
    O(d, 3) = I(r, 4)
  ElseIf InStr(I(r, 3), "Ref") > 0 Then
    O(d, 4) = I(r, 4)
  End If
Next r
Range("G1").Resize(UBound(O), 4) = O
Range("I2:I" & UBound(O)).NumberFormat = "#,##0.00"
Columns("G:J").AutoFit
End Sub

Then run the ReorgDataV2 macro.

 

[pto160]

Unbelievable. This works great and it is very fast. Thank you.

 

[hiker95]

pto160,

Thanks for the feedback.

Glad I could help.

You are very welcome.

Come back anytime.