PDA

View Full Version : Rearrange Excel Sheet to uploadable File for SQL Server



pdx_2188
04-13-2011, 01:11 PM
I currently have a worksheet that provides data all over the place. I need to be able to rearrange the cells so they read smoothly across the board.

Example Header:

Part Number Jan(QTY) February(QTY) March(QTY) Description
123456 1 0 0 HP WorkStation

The Description is currently under the Part Number. The QTY's that is not currently in bold are the QTY's I can delete as it duplicates the QTY's acrodd the description line as well.

I think it may need to be something like:

If Range(B:D) is not bold then Delete Row Range(B:D) and Move Row in Column A associated with deleted rows to Column E

Else Nothing

End

This may need a For Each loop I'm not sure. I do have some macro experience, but I have never been great at data manipulation

Any help would be greatly appreciated!

Please let me know if you have any questions.

Thanks,
Jeff

BrianMH
04-13-2011, 02:16 PM
I note that on your spreadsheet the description is always on even rows and under the part number. If this is always the case then the code below will work for the way you have formatted your spreadsheet. It will copy the data to a new sheet in the way you wanted it formatted.


Sub rearrange()
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim rwBottom As Long
Dim r As Range
Dim rOutput As Range
Dim c As Range
Dim i As Integer
Set s1 = ThisWorkbook.Sheets(1)
Set s2 = ThisWorkbook.Sheets.Add
s2.Cells(1, 1) = "Part Number"
s2.Cells(1, 2) = "Jan(QTY)"
s2.Cells(1, 3) = "February(QTY)"
s2.Cells(1, 4) = "March(QTY)"
s2.Cells(1, 5) = "Description "
rwBottom = s1.Cells(s1.Rows.Count, 1).End(xlUp).Row
Set r = s1.Range("A3:A" & rwBottom)
For Each c In r.Cells
i = c.Row Mod 2
If i = 1 Then
rwBottom = s2.Cells(s2.Rows.Count, 1).End(xlUp).Row
rwBottom = rwBottom + 1
Set rOutput = s2.Cells(rwBottom, 1)
rOutput.Value = c.Value
rOutput.Offset(0, 1).Value = c.Offset(0, 1).Value
rOutput.Offset(0, 2).Value = c.Offset(0, 2).Value
rOutput.Offset(0, 3).Value = c.Offset(0, 3).Value
rOutput.Offset(0, 4).Value = c.Offset(1, 0).Value
End If
Next
End Sub

pdx_2188
04-13-2011, 02:51 PM
Thank you so much!