PDA

View Full Version : extract data from Excel Columns to an Output sheet



Pamella
07-29-2019, 02:31 AM
I have 2 sheet. One is the Source- This contains 1) ID no.s in Column B starting from Cell B3. 2) Colour in Column C and 3) The Amounts I have to retrieve are in Column E.
Then in the Output Sheet, I must paste the ID no. in column A. (in an un-used row), next paste the Amount in the same row. Row 1 in Output sheet contains all the Colours. So the macro would have to find the corresponding colour from source and match it to the one in Output and paste in the correct matching cell.

Column B which contains the Id's some contains blanks because it has multiple colours.

Source sheet would look like this

A B C D E
name ID Colour Amount Status
asda A1 Red 12
cccc 1B Red 76
ddd 2C Red 56
Blue 78
Green 532
Yellow 43
qqq 34V Yellow 566



Outputsheet would look like this...

Red Blue Green Yellow
1A 12
1B 76
2C 56 78 532 43
34V 566

xld
07-29-2019, 04:15 AM
Public Sub ExtractData()
Dim wsRes As Worksheet
Dim nextrow As Long
Dim lastrow As Long
Dim i As Long

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Output").Delete
Application.DisplayAlerts = True
On Error GoTo 0

With ActiveSheet

Set wsRes = Worksheets.Add(after:=Worksheets(Worksheets.Count))
wsRes.Name = "Output"
wsRes.Range("A1:E1").Value = Array("Id", "Red", "Blue", "Green", "Yellow")

nextrow = 1
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 2 To lastrow

If Not .Cells(i, "B").Value = vbNullString Then

nextrow = nextrow + 1
.Cells(i, "B").Copy wsRes.Cells(nextrow, "A")
End If
.Cells(i, "E").Copy wsRes.Cells(nextrow, wsRes.Cells(nextrow, wsRes.Columns.Count).End(xlToLeft).Column + 1)
Next i
End With
End Sub

Pamella
07-29-2019, 06:32 PM
The Output sheet already exists. I cant see where it is pasting in the Output sheet? I require it to find the ID and paste in column A if it doesnt already exist, then add the amount under the correct colour. There will be more than 20 colours so dont want to add them to an array simply find a match. Something like this.

Set rngFoundCells = wOutput.Rows(1).Find(What:=CStr(strColour), LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)