Macro to choose data based on cell values in a column

[akeemali]

I hope someone out there can help. I have a worksheet with values in column A that are based on a personal id for an individual and then the next columns have information for that individual. So for instance I have info for the same individual in rows 1 to 16 then the next individual in rows 17 to 99 and then for the next in rows 100 to 121, etc...so the info for individuals is not the same number of rows always.

What I would like to do is to create a macro that allows me to copy cells in column F of the worksheet based on the value of column A. The value in column A is numeric id number. I would then like to paste these copied cells into another worksheet (and transposed the info into one row instead of several rows) i.e. for instance copy f1:f16 and paste into A1 in another worksheet and so on. This is because I have another worksheet with all the info for an individual laid out on one row instead of several rows like I have in this worksheet.

I am able to record a macro to select data for a particular personal id and paste special (values only and transposed) into the other worksheet but my problem is that I still have to manually select for each personal id and this is becoming quite a chore...as I need to do this for about 98,000 records! Can someone please help by just telling me or giving me the vba code to select a range of cells based on the value in a particular column.

Thanks to any helper(s) out there...

 

[HalfAce]

Hello akeemali, welcome to the board.
Here's a little variation on something I saw Erik do recently. If I understand what you're wanting it should work. It assumes you have a header row in sheet1 (where the original data is) and that if there are any blanks in column A, they are only between the ID number changes.

Sub Copy_And_Transpose()
Dim c As Range, LstRow As Range
Dim r As Long
Set LstRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Set c = Cells(2, 1)
Application.ScreenUpdating = False

Do While Not c.Row > LstRow.Row
  r = c.Row
  Set c = Range(c, LstRow.Offset(1, 0)).ColumnDifferences(c)(1)
  Range(Cells(r, 1), Cells(c.Row - 1, 1)).Offset(, 5).Copy
    With Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)(2, 1)
      .PasteSpecial Paste:=xlValues, Transpose:=True
    End With
Loop
 
With Application
  .CutCopyMode = False
  .ScreenUpdating = True
End With

End Sub

Hope it helps.

 

[akeemali]

HalfAce,

Thanks so much for your help...and as luck would have it I actually dropped my tablet pc after posting my request the other day...luckily it was only the hdd that was damaged I am now back online.

I tried the code you sent me just a few minutes ago and it has a problem at various lines...

Do you mind if I send out a sample of the file to see what I am trying o do?


Thanks again.
akeemali

 

[HalfAce]

No, I don't really mind you sending a copy of the workbook, but for the benefit of others searching/reading this thread I'd rather see if we can figure it out here on the board first.

Can you describe the errors you're getting and what line(s) are highlighted when they occur?

 

[akeemali]

actually, the error materialises at different points in the macro...I should think that sending the xls file out is the easiest way to see what I am trying todo and where the error(s) are...thanks

 

[akeemali]

sheet 1

Gordon Merger.xls
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1	Patient	HbA1c	Totalcholesterollevel	Trilevel	BMI		med1	med2	med3	med4	med5	med6	med7	med8	med9	med10
2	7	6.1	7.3	8.4	23.9
3	39	8.9	4.2	7	39.5
4	84	11.5	5.2	1	23.4
Datasheet1

 

[akeemali]

datasheet2

Gordon Merger.xls
	A	B	C	D
1	7	4.1.4TemazepamTablets10mg18/02/2004		TemazepamTablets10mg
2	7	6.3.4PrednisoloneE/CTablets5mg38696		PrednisoloneE/CTablets5mg
3	7	3.1.2IpratropiumSteri-NebNebuliserSolution250micrograms/1ml27/10/2005		IpratropiumSteri-NebNebuliserSolution250micrograms/1ml
4	7	2.9AspirinDispersibleTablets75mg38543		AspirinDispersibleTablets75mg
5	7	3.1.1.1SalmeterolXinafoateAccuhaler50micrograms/dose38543		SalmeterolXinafoateAccuhaler50micrograms/dose
6	7	4.3.3SertralineHydrochlorideTablets100mg38543		SertralineHydrochlorideTablets100mg
7	7	3.1.1.1SalbutamolCfc-FreeInhaler100micrograms/puff38543		SalbutamolCfc-FreeInhaler100micrograms/puff
8	7	2.9ClopidogrelHydrogenSulphateTablets75mg38543		ClopidogrelHydrogenSulphateTablets75mg
9	7	2.6.1GlycerylTrinitrateCfc-FreePumpSpray400micrograms/dose38543		GlycerylTrinitrateCfc-FreePumpSpray400micrograms/dose
10	7	21.8OxygenCylinder1360litres38421		OxygenCylinder1360litres
11	7	4.7.1Co-Codamol30/500EffervescentTablets38543		Co-Codamol30/500EffervescentTablets
12	7	2.6NicorandilTablets20mg38543		NicorandilTablets20mg
13	7	2.6NicorandilTablets10mg38543		NicorandilTablets10mg
14	7	2.2.2FurosemideTablets40mg38543		FurosemideTablets40mg
15	7	2.6.2DiltiazemHydrochlorideM/RCapsules180mg38543		DiltiazemHydrochlorideM/RCapsules180mg
16	7	2.6.1IsosorbideMononitrateM/RCapsules60mg38543		IsosorbideMononitrateM/RCapsules60mg
17	39	14.4EnziraSuspensionForInjection0.5mlpre-filledsyringe13/10/2005		EnziraSuspensionForInjection0.5mlpre-filledsyringe
18	39	6.1.2.2MetforminHydrochlorideTablets850mg30/09/2005		MetforminHydrochlorideTablets850mg
19	39	6.1AdvantageIiTestStrips30/09/2005		AdvantageIiTestStrips
20	39	2.2.2FurosemideTablets40mg38512		FurosemideTablets40mg
21	39	6.1NovofineNeedlesForInsulinPens30g8mm30/09/2005		NovofineNeedlesForInsulinPens30g8mm
22	39	3.4.1CetirizineHydrochlorideTablets10mg30/09/2005		CetirizineHydrochlorideTablets10mg
23	39	2.4BisoprololFumarateTablets1.25mg30/09/2005		BisoprololFumarateTablets1.25mg
24	39	10.1.1DiclofenacSodiumE/CTablets50mg38693		DiclofenacSodiumE/CTablets50mg
25	84	4.3.1LofepramineTablets70mg19/10/2005		LofepramineTablets70mg
26	84	2.9AspirinE/CTablets75mg19/10/2005		AspirinE/CTablets75mg
27	84	6.1AdvantageIiTestStrips19/10/2005		AdvantageIiTestStrips
28	84	2.12AtorvastatinTablets20mg19/10/2005		AtorvastatinTablets20mg
29	84	6.1Bd-Microfine+NeedlesForInsulinPens8mm/31gauge19/10/2005		Bd-Microfine+NeedlesForInsulinPens8mm/31gauge
30	84	2.5.5.1RamiprilCapsules1.25mg19/10/2005		RamiprilCapsules1.25mg
Datasheet2

 

[akeemali]

my problem described...

so what would like to do is copy column B in datasheet 2 and paste into columns G to P in datasheet1. For instance data in B1:B9 of datasheet 2 go into G1:P1 of datasheet1, data in B17:B24 of datasheet2 go into H1:P1, etc...

So, the macro I need has to select data from column B in datasheet 2 based on the value of column A in the same sheet, then copy such data, activate datasheet 1 and transpose and paste the copied data into coulmns G to P based on the value of column A in datasheet 1 (which correspnds to value of column A in datasheet 2 as it is the same personal id)...

I hope this is posible! Thanks everyone for your support...otherwise I will have to do this for more than 30000 personal ids!!!

 

[akeemali]

It seems that I am really stumpedhere and there is no hope that this will work or is there any help out there?