PDA

View Full Version : Solved: Organize inconsistant data from 2 columns to 1 column on different sheet



lucas
11-17-2007, 11:31 AM
I am trying to copy data to a second sheet and some of if is in one column and some in the column next to it..

from sheet 1 I need to copy Column A and B to one column on sheet 2 and have their associated labels(in col C) put next to them.

I'm kinda stuggling with this so If anyone can point me in the right direction I would appreciate any input.

Attached file has some notes to help you understand.

lucas
11-17-2007, 11:38 AM
You will also notice that if they are found in column B that their label does not follow them to sheet 2.....just to make it more interesting.

Bob Phillips
11-17-2007, 12:42 PM
Does this do it Steve



Public Sub ProcessData()
Const TEST_COLUMN As String = "D"
Const SHEET_NAME As String = "Memory Map"
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
Dim NumRows As Long
Dim sh As Worksheet

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
NextRow = 4
On Error Resume Next
Application.DisplayAlerts = False
.Parent.Worksheets(SHEET_NAME).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set sh = Worksheets.Add
sh.Name = SHEET_NAME
For i = 4 To LastRow

NumRows = 1
sh.Cells(NextRow, "B").Value = .Cells(i, TEST_COLUMN).Offset(0, -2)
.Cells(i, TEST_COLUMN).Copy sh.Cells(NextRow, "C")
If .Cells(i, TEST_COLUMN).Offset(0, -1).Value <> "" Then

NumRows = 2
sh.Cells(NextRow + 1, "B") = .Cells(i, TEST_COLUMN).Offset(0, -1)
End If
With sh.Cells(NextRow, "C").Resize(NumRows, 2)
.BorderAround ColorIndex:=xlAutomatic, Weight:=xlThin
.Interior.ColorIndex = 15
End With
If NumRows = 2 Then NextRow = NextRow + 1
If .Cells(i, TEST_COLUMN).Offset(0, 1).Value <> _
.Cells(i + 1, TEST_COLUMN).Offset(0, 1).Value Then

NextRow = NextRow + 1
.Cells(i, TEST_COLUMN).Offset(0, 1).Copy
sh.Cells(NextRow, "D").PasteSpecial Paste:=xlValues
sh.Cells(NextRow, "C").Resize(, 2).BorderAround _
ColorIndex:=xlAutomatic, Weight:=xlThin
End If

NextRow = NextRow + 1
Next i
sh.Columns("C:D").AutoFit
End With
End Sub

Bob Phillips
11-17-2007, 12:49 PM
Forgot a small bit



Public Sub ProcessData()
Const TEST_COLUMN As String = "D"
Const SHEET_NAME As String = "Memory Map"
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
Dim NumRows As Long
Dim sh As Worksheet

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
NextRow = 4
On Error Resume Next
Application.DisplayAlerts = False
.Parent.Worksheets(SHEET_NAME).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set sh = Worksheets.Add
sh.Name = SHEET_NAME
For i = 4 To LastRow

NumRows = 1
sh.Cells(NextRow, "B").Value = .Cells(i, TEST_COLUMN).Offset(0, -2)
sh.Cells(NextRow, "C").Value = .Cells(i, TEST_COLUMN)
If .Cells(i, TEST_COLUMN).Offset(0, -1).Value <> "" Then

NumRows = 2
sh.Cells(NextRow + 1, "B") = .Cells(i, TEST_COLUMN).Offset(0, -1)
End If
With sh.Cells(NextRow, "C").Resize(NumRows, 2)
.BorderAround ColorIndex:=xlAutomatic, Weight:=xlThin
.Interior.ColorIndex = 15
End With
If NumRows = 2 Then NextRow = NextRow + 1
If .Cells(i, TEST_COLUMN).Offset(0, 1).Value <> _
.Cells(i + 1, TEST_COLUMN).Offset(0, 1).Value Then

NextRow = NextRow + 1
.Cells(i, TEST_COLUMN).Offset(0, 1).Copy
sh.Cells(NextRow, "D").PasteSpecial Paste:=xlValues
sh.Cells(NextRow, "C").Resize(, 2).BorderAround _
ColorIndex:=xlAutomatic, Weight:=xlThin
End If

NextRow = NextRow + 1
Next i
sh.Columns("C:D").AutoFit
End With
End Sub

lucas
11-17-2007, 01:05 PM
Just amazing Bob. Thanks.
Love the pastespecial to get rid of the formula's. This was one of the if statements I couldn't wrap my head around(seems obvious enough now):
If .Cells(i, TEST_COLUMN).Offset(0, -1).Value <> "" Then

NumRows = 2
sh.Cells(NextRow + 1, "B") = .Cells(i, TEST_COLUMN).Offset(0, -1)
End If
With sh.Cells(NextRow, "C").Resize(NumRows, 2)
.BorderAround ColorIndex:=xlAutomatic, Weight:=xlThin
.Interior.ColorIndex = 15
End With

lucas
11-17-2007, 01:15 PM
Borders cleaned up nicely with the second one Bob.

Bob Phillips
11-17-2007, 01:51 PM
Yeah, I still had a copy in the first which I hadn't changed to a set to value, so the border came with it.