x
Solved

EXCEL Macro

Posted on 2014-04-01
Medium Priority
368 Views
Hello,
I have a macro that connects to my SQL database and have a select statement  to import some data into the excel sheet (Columns "M" to "BF").
Number of rows are different.

Is there any way (macro code) that can  sort the data as in my sample sheet.
Example
A25 = M2,  B25 = N2, C25 =O2, C26 = P2, C27 = Q2.....
A33 = M3, B33 = N3, C33 =O3, C34 = P3, C35 = Q3.....
A41 = M4, B41 = N4, C41 =O4,C42 = P4, C43 = Q4.....

thanks
sample.xls
0
Question by:W.E.B
• 3
• 3

LVL 81

Assisted Solution

byundt earned 800 total points
ID: 39971344
Here is a macro that will rewrite your data. Install it in a regular module sheet. The macro is specific to your data layout.
``````Sub DataRewriter()
Dim rg As Range
Dim i As Long, j As Long, nRows As Long
Dim v As Variant, vData As Variant
Application.ScreenUpdating = False
Set rg = Range("M2").CurrentRegion
If rg.Cells(1, 1).Address <> "\$M\$2" Then Set rg = Range(Range("M2"), rg.Cells(rg.Rows.Count, rg.Columns.Count))
vData = rg.Value
nRows = rg.Rows.Count
For i = 1 To nRows
ReDim v(1 To 7, 1 To 8)
v(1, 1) = vData(i, 1)
v(1, 2) = vData(i, 2)
For j = 1 To 6
v(j, 3) = vData(i, 2 + j)
v(j, 4) = vData(i, 8 + j)
Next
v(1, 5) = vData(i, 15)
v(2, 5) = vData(i, 16)
v(1, 6) = vData(i, 17)
v(2, 6) = vData(i, 18)
For j = 1 To 5
v(2 + j, 5) = vData(i, 17 + j * 2)
v(2 + j, 6) = vData(i, 18 + j * 2)
Next
For j = 1 To 4
v(j, 7) = vData(i, 28 + j)
v(j, 8) = vData(i, 32 + j)
Next
Range("A25").Offset((i - 1) * 8, 0).Resize(7, 8).Value = v
Next
End Sub
``````
sampleQ28402837.xls
0

LVL 55

Expert Comment

ID: 39971454
Hi,

pls try this

``````Sub macro()
Dim FirstCell As Range
Columns("H:H").NumberFormat = """\$""#,##0.00_);(""\$""#,##0.00)"
For Each c In Range(Range("M2"), Range("M" & Cells.Rows.Count).End(xlUp))
ActualRow = c.Row
Set FirstCell = Range("A" & 25 + ((ActualRow - 2) * 8))
Range(FirstCell, _
FirstCell.Offset(6, 7)).Interior.Color = c.Interior.Color
FirstCell = c
FirstCell.Offset(0, 1) = c.Offset(0, 1)
FirstCell.Offset(0, 2).Resize(6, 1) = WorksheetFunction.Transpose(c.Offset(0, 2).Resize(1, 6))
FirstCell.Offset(0, 3).Resize(6, 1) = WorksheetFunction.Transpose(c.Offset(0, 8).Resize(1, 6))
FirstCell.Offset(0, 4).Resize(2, 1) = WorksheetFunction.Transpose(c.Offset(0, 14).Resize(1, 2))
FirstCell.Offset(2, 4) = c.Offset(0, 18)
FirstCell.Offset(3, 4) = c.Offset(0, 20)
FirstCell.Offset(4, 4) = c.Offset(0, 22)
FirstCell.Offset(5, 4) = c.Offset(0, 24)
FirstCell.Offset(6, 4) = c.Offset(0, 26)
FirstCell.Offset(0, 5).Resize(2, 1) = WorksheetFunction.Transpose(c.Offset(0, 16).Resize(1, 2))
FirstCell.Offset(2, 5) = c.Offset(0, 19)
FirstCell.Offset(3, 5) = c.Offset(0, 21)
FirstCell.Offset(4, 5) = c.Offset(0, 23)
FirstCell.Offset(5, 5) = c.Offset(0, 25)
FirstCell.Offset(5, 5).NumberFormat = "dd/mm/yyyy"
FirstCell.Offset(6, 5) = c.Offset(0, 27)
FirstCell.Offset(0, 6).Resize(4, 1) = WorksheetFunction.Transpose(c.Offset(0, 28).Resize(1, 4))
FirstCell.Offset(0, 7).Resize(4, 1) = WorksheetFunction.Transpose(c.Offset(0, 32).Resize(1, 4))

Next
End Sub
``````
Regards
Copy-of-sample.xlsm
0

Author Comment

ID: 39971989
Hello,
thank you for the help.

Rgonzo1971, I get error when trying the code.
Variable not defined. (must be variant or object)
For Each c In Range(Range("M2"), .....

byundt, I'm testing your code now.

Thank you
0

LVL 55

Expert Comment

ID: 39972010
Hi,

pls try

``````Sub macro()
Dim FirstCell As Range, c As Range
Columns("H:H").NumberFormat = """\$""#,##0.00_);(""\$""#,##0.00)"
For Each c In Range(Range("M2"), Range("M" & Cells.Rows.Count).End(xlUp))
Set FirstCell = Range("A" & 25 + ((c.Row - 2) * 8))
Range(FirstCell, _
FirstCell.Offset(6, 7)).Interior.Color = c.Interior.Color
FirstCell = c
FirstCell.Offset(0, 1) = c.Offset(0, 1)
FirstCell.Offset(0, 2).Resize(6, 1) = WorksheetFunction.Transpose(c.Offset(0, 2).Resize(1, 6))
FirstCell.Offset(0, 3).Resize(6, 1) = WorksheetFunction.Transpose(c.Offset(0, 8).Resize(1, 6))
FirstCell.Offset(0, 4).Resize(2, 1) = WorksheetFunction.Transpose(c.Offset(0, 14).Resize(1, 2))
FirstCell.Offset(2, 4) = c.Offset(0, 18)
FirstCell.Offset(3, 4) = c.Offset(0, 20)
FirstCell.Offset(4, 4) = c.Offset(0, 22)
FirstCell.Offset(5, 4) = c.Offset(0, 24)
FirstCell.Offset(6, 4) = c.Offset(0, 26)
FirstCell.Offset(0, 5).Resize(2, 1) = WorksheetFunction.Transpose(c.Offset(0, 16).Resize(1, 2))
FirstCell.Offset(2, 5) = c.Offset(0, 19)
FirstCell.Offset(3, 5) = c.Offset(0, 21)
FirstCell.Offset(4, 5) = c.Offset(0, 23)
FirstCell.Offset(5, 5) = c.Offset(0, 25)
FirstCell.Offset(5, 5).NumberFormat = "dd/mm/yyyy"
FirstCell.Offset(6, 5) = c.Offset(0, 27)
FirstCell.Offset(0, 6).Resize(4, 1) = WorksheetFunction.Transpose(c.Offset(0, 28).Resize(1, 4))
FirstCell.Offset(0, 7).Resize(4, 1) = WorksheetFunction.Transpose(c.Offset(0, 32).Resize(1, 4))

Next
End Sub
``````
Regards
0

Author Comment

ID: 39972188
Thank you guys, both working as expected.

Rgonzo1971,
when running your code, there are no grid lines.
how can I show the grid lines ?

I tried using , with no luck
ActiveWindow.DisplayGridlines = True

thanks
0

LVL 55

Accepted Solution

Rgonzo1971 earned 1200 total points
ID: 39972234
Hi,

If you want the colors used in the list and a grid use this

``````Sub macro()
Dim FirstCell As Range
Rows("25:" & Cells.Rows.Count).EntireRow.Delete
Columns("H:H").NumberFormat = """\$""#,##0.00_);(""\$""#,##0.00)"
For Each c In Range(Range("M2"), Range("M" & Cells.Rows.Count).End(xlUp))
ActualRow = c.Row
Set FirstCell = Range("A" & 25 + ((ActualRow - 2) * 8))
With Range(FirstCell, FirstCell.Offset(6, 7))
.Interior.Color = c.Interior.Color
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
End With

FirstCell = c
FirstCell.Offset(0, 1) = c.Offset(0, 1)
FirstCell.Offset(0, 2).Resize(6, 1) = WorksheetFunction.Transpose(c.Offset(0, 2).Resize(1, 6))
FirstCell.Offset(0, 3).Resize(6, 1) = WorksheetFunction.Transpose(c.Offset(0, 8).Resize(1, 6))
FirstCell.Offset(0, 4).Resize(2, 1) = WorksheetFunction.Transpose(c.Offset(0, 14).Resize(1, 2))
FirstCell.Offset(2, 4) = c.Offset(0, 18)
FirstCell.Offset(3, 4) = c.Offset(0, 20)
FirstCell.Offset(4, 4) = c.Offset(0, 22)
FirstCell.Offset(5, 4) = c.Offset(0, 24)
FirstCell.Offset(6, 4) = c.Offset(0, 26)
FirstCell.Offset(0, 5).Resize(2, 1) = WorksheetFunction.Transpose(c.Offset(0, 16).Resize(1, 2))
FirstCell.Offset(2, 5) = c.Offset(0, 19)
FirstCell.Offset(3, 5) = c.Offset(0, 21)
FirstCell.Offset(4, 5) = c.Offset(0, 23)
FirstCell.Offset(5, 5) = c.Offset(0, 25)
FirstCell.Offset(5, 5).NumberFormat = "dd/mm/yyyy"
FirstCell.Offset(6, 5) = c.Offset(0, 27)
FirstCell.Offset(0, 6).Resize(4, 1) = WorksheetFunction.Transpose(c.Offset(0, 28).Resize(1, 4))
FirstCell.Offset(0, 7).Resize(4, 1) = WorksheetFunction.Transpose(c.Offset(0, 32).Resize(1, 4))
Next
End Sub
``````
Or if you want No color at all use this
``````Sub macro()
Dim FirstCell As Range
Rows("25:" & Cells.Rows.Count).EntireRow.Delete
Columns("H:H").NumberFormat = """\$""#,##0.00_);(""\$""#,##0.00)"
For Each c In Range(Range("M2"), Range("M" & Cells.Rows.Count).End(xlUp))
ActualRow = c.Row
Set FirstCell = Range("A" & 25 + ((ActualRow - 2) * 8))
FirstCell = c
FirstCell.Offset(0, 1) = c.Offset(0, 1)
FirstCell.Offset(0, 2).Resize(6, 1) = WorksheetFunction.Transpose(c.Offset(0, 2).Resize(1, 6))
FirstCell.Offset(0, 3).Resize(6, 1) = WorksheetFunction.Transpose(c.Offset(0, 8).Resize(1, 6))
FirstCell.Offset(0, 4).Resize(2, 1) = WorksheetFunction.Transpose(c.Offset(0, 14).Resize(1, 2))
FirstCell.Offset(2, 4) = c.Offset(0, 18)
FirstCell.Offset(3, 4) = c.Offset(0, 20)
FirstCell.Offset(4, 4) = c.Offset(0, 22)
FirstCell.Offset(5, 4) = c.Offset(0, 24)
FirstCell.Offset(6, 4) = c.Offset(0, 26)
FirstCell.Offset(0, 5).Resize(2, 1) = WorksheetFunction.Transpose(c.Offset(0, 16).Resize(1, 2))
FirstCell.Offset(2, 5) = c.Offset(0, 19)
FirstCell.Offset(3, 5) = c.Offset(0, 21)
FirstCell.Offset(4, 5) = c.Offset(0, 23)
FirstCell.Offset(5, 5) = c.Offset(0, 25)
FirstCell.Offset(5, 5).NumberFormat = "dd/mm/yyyy"
FirstCell.Offset(6, 5) = c.Offset(0, 27)
FirstCell.Offset(0, 6).Resize(4, 1) = WorksheetFunction.Transpose(c.Offset(0, 28).Resize(1, 4))
FirstCell.Offset(0, 7).Resize(4, 1) = WorksheetFunction.Transpose(c.Offset(0, 32).Resize(1, 4))
Next
End Sub
``````
Regards
0

Author Closing Comment

ID: 39972254
Thank you very much guys.
Much appreciated.
0

Featured Post

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.