VBA Consolidate Data

[Stephen_IV]

I have attendace that comes out of our system in different date ranges like below (This is why there is multiple lines of data). I am trying to consolidate it like the last table in the post. This is just a small example I have over 100,000 rows of data. Could someone please help me with. Thank you in advance Stephen!

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1	ID	8/25	8/26	8/27	8/30	8/31	9/1	9/2	9/3	9/7	9/8	9/10	9/13	9/14	9/15	9/16	9/17
2	102		A
3	102																A
4	102
5	102
6	102
7	102
8	102
9	102
10	103									A
11	103
12	103
13	103			A
14	103
15	103
16	103
17	103
18	103															A	A
19	103
20	103
Sheet1

Into this,

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1	Employee ID	8/25	8/26	8/27	8/30	8/31	9/1	9/2	9/3	9/7	9/8	9/10	9/13	9/14	9/15	9/16	9/17
2	102		A														A
3	103			A						A						A	A
Sheet2

 

[hiker95]

Stephen_IV,


Sample worksheets before the macro:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1	ID	8-25	8-26	8-27	8-30	8-31	9-1	9-2	9-3	9-7	9-8	9-10	9-13	9-14	9-15	9-16	9-17
2	102		A
3	102																A
4	102
5	102
6	102
7	102
8	102
9	102
10	103									A
11	103
12	103
13	103			A
14	103
15	103
16	103
17	103
18	103															A	A
19	103
20	103
21
Sheet1

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1
2
3
4
Sheet2

After the macro:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1	Employee ID	8-25	8-26	8-27	8-30	8-31	9-1	9-2	9-3	9-7	9-8	9-10	9-13	9-14	9-15	9-16	9-17
2	102		A														A
3	103			A						A						A	A
4
Sheet2

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub ReorgData()
' hiker95, 07/07/2011
' http://www.mrexcel.com/forum/showthread.php?t=562452
Dim w1 As Worksheet, w2 As Worksheet
Dim LR As Long, LC As Long, SR As Long, ER As Long
Dim a As Long, aa As Long, b As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
Set w2 = Worksheets("Sheet2")
LR = w1.Cells(Rows.Count, 1).End(xlUp).Row
LC = w1.Cells(1, Columns.Count).End(xlToLeft).Column
w1.Range(w1.Cells(2, 1), w1.Cells(LR, LC)).Sort Key1:=w1.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
w2.UsedRange.ClearContents
w1.Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=w2.Columns(1), Unique:=True
w1.Range(w1.Cells(1, 1), w1.Cells(1, LC)).Copy w2.Range("A1")
LR = w2.Cells(Rows.Count, 1).End(xlUp).Row
For a = 2 To LR Step 1
  SR = Application.Match(w2.Cells(a, 1), w1.Columns(1), 0)
  ER = Application.Match(w2.Cells(a, 1), w1.Columns(1), 1)
  For aa = SR To ER Step 1
    For b = 2 To LC Step 1
      If w1.Cells(aa, b) <> "" Then w2.Cells(a, b).Value = w1.Cells(aa, b).Value
    Next b
  Next aa
Next a
w2.Range("A1") = "Employee ID"
w2.UsedRange.Columns.AutoFit
w2.UsedRange.HorizontalAlignment = xlCenter
w2.Activate
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm


Then run the ReorgData macro.

 

[Stephen_IV]

hiker95,

You are a lifesaver! Thanks you so so much! It works great and saved me a tone of time. I appreciate it! Thank you again!

 

[hiker95]

Stephen_IV,

You are very welcome.

Glad I could help.

Thanks for the feedback.

Come back anytime.


For my own personal information: How much time in hours do you think my macro will save you per day/week/month?

Please send your company name, and web site.