Silver
04-17-2015, 11:13 AM
There are 2 sheets Main File and DBR Report.
Main File is where the data is pasted.Since data is generated for 2 clients (code is AA and US) it contains 2 buttons.
DBR Report contains Template into which data is pasted into specific columns from Main File.
What the Macro does is -
1)When AA button is clicked, data from Main File is pasted into specific columns in the Template and Column Q is updated with Code AA. Same activity is performed when US button is clicked only Column Q is updated with Code US.
2)Depending on the volume of data in the Main File the macro adds or deduct rows from the template format.
3)Duplicates data in Columns A and B one below the other
4)Creates individual workbook of DBR Report sheet and saves it as AA_REACC_Draft_20Apr
Note :
Data is pasted into the template from Column C to R - Row 4 onwards.
Below is the code
Option Explicit
Sub test(colQ As String)
'Clears Existing data in Template
Sheets("DBR Report").Rows("6:500").Delete
Sheets("DBR Report").Range("C4:R5").ClearContents
'Creates Correct number of rows in template
Dim r, Lastrow As Integer
Lastrow = Sheets("main file").Range("A" & Rows.Count).End(3).Row
r = 2
Do While r + 1 <= Lastrow
If Range("A" & r) <> "" Then
Sheets("DBR Report").Rows("4:5").Copy Sheets("DBR Report").Rows(Rows.Count).End(3)(2)
End If
r = r + 1
Loop
'Copies data into template
Dim a, i As Long, n As Long, temp, e
a = Sheets("main file").UsedRange.Value: n = 2
With Sheets("dbr report")
For i = 2 To UBound(a, 1)
If a(i, 1) <> "" Then
n = n + 2
.Cells(n, 3).Resize(, 7).Value = _
Array(Val(a(i, 4)), a(i, 6), a(i, 8), a(i, 10), a(i, 12), _
DateValue(Left$(a(i, 2), 4) & "/" & Mid$(a(i, 2), 5, 2) & "/" & Right$(a(i, 2), 2)), _
DateValue(Left$(a(i, 3), 4) & "/" & Mid$(a(i, 3), 5, 2) & "/" & Right$(a(i, 3), 2)))
.Cells(n, 18).Value = a(i, 1)
.Cells(n, 17).Value = colQ
For Each e In Split(StrConv(Replace(a(i, 14), " ", ""), 64), Chr(0))
If e <> "" Then .Cells(n, Val(e) + 9).Value = e
Next
End If
Next
End With
'Exports Template
Sheets("DBR Report").Copy
ActiveSheet.Name = "AA_REACC_Draft_" & Format(Now, "ddmmm")
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & colQ & "_REACC_Draft_" & Format(Now, "ddmmm") & ".xlsx"
End Sub
Rows in Column A are identified as (In the Template)
Row4 - FR:
Row5 - TO:
Row6 - FR:
Row7 - TO:
Basically macro copies data onto rows which reflect FR: and leaves rows reflecting TO: blanks
(Done from Column C to R)
Looking for below additions to the above code :
1)Above code pastes code AA or US to rows reflecting FR: only in Column Q. Want the code to paste AA or US to rows reflecting FR: and TO:
2)Column H and I (Template) is updated with Dates in rows reflecting FR: only. Want the macro to update 1st set of dates to rows reflecting FR: and TO: 2nd set of dates to the next row reflecting FR: and TO:
Ex :
Date in Main File (Column B and C)
20150828
20150831
20150328
20150330
Template
FR:
28-Aug-15
31-Aug-15
TO:
28-Aug-15
31-Aug-15
FR:
28-Mar-15
30-Mar-15
TO:
28-Mar-15
30-Mar-15
Attached sample sheet with explanation (DBR Report will give an idea what exactly I want)
Main File is where the data is pasted.Since data is generated for 2 clients (code is AA and US) it contains 2 buttons.
DBR Report contains Template into which data is pasted into specific columns from Main File.
What the Macro does is -
1)When AA button is clicked, data from Main File is pasted into specific columns in the Template and Column Q is updated with Code AA. Same activity is performed when US button is clicked only Column Q is updated with Code US.
2)Depending on the volume of data in the Main File the macro adds or deduct rows from the template format.
3)Duplicates data in Columns A and B one below the other
4)Creates individual workbook of DBR Report sheet and saves it as AA_REACC_Draft_20Apr
Note :
Data is pasted into the template from Column C to R - Row 4 onwards.
Below is the code
Option Explicit
Sub test(colQ As String)
'Clears Existing data in Template
Sheets("DBR Report").Rows("6:500").Delete
Sheets("DBR Report").Range("C4:R5").ClearContents
'Creates Correct number of rows in template
Dim r, Lastrow As Integer
Lastrow = Sheets("main file").Range("A" & Rows.Count).End(3).Row
r = 2
Do While r + 1 <= Lastrow
If Range("A" & r) <> "" Then
Sheets("DBR Report").Rows("4:5").Copy Sheets("DBR Report").Rows(Rows.Count).End(3)(2)
End If
r = r + 1
Loop
'Copies data into template
Dim a, i As Long, n As Long, temp, e
a = Sheets("main file").UsedRange.Value: n = 2
With Sheets("dbr report")
For i = 2 To UBound(a, 1)
If a(i, 1) <> "" Then
n = n + 2
.Cells(n, 3).Resize(, 7).Value = _
Array(Val(a(i, 4)), a(i, 6), a(i, 8), a(i, 10), a(i, 12), _
DateValue(Left$(a(i, 2), 4) & "/" & Mid$(a(i, 2), 5, 2) & "/" & Right$(a(i, 2), 2)), _
DateValue(Left$(a(i, 3), 4) & "/" & Mid$(a(i, 3), 5, 2) & "/" & Right$(a(i, 3), 2)))
.Cells(n, 18).Value = a(i, 1)
.Cells(n, 17).Value = colQ
For Each e In Split(StrConv(Replace(a(i, 14), " ", ""), 64), Chr(0))
If e <> "" Then .Cells(n, Val(e) + 9).Value = e
Next
End If
Next
End With
'Exports Template
Sheets("DBR Report").Copy
ActiveSheet.Name = "AA_REACC_Draft_" & Format(Now, "ddmmm")
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & colQ & "_REACC_Draft_" & Format(Now, "ddmmm") & ".xlsx"
End Sub
Rows in Column A are identified as (In the Template)
Row4 - FR:
Row5 - TO:
Row6 - FR:
Row7 - TO:
Basically macro copies data onto rows which reflect FR: and leaves rows reflecting TO: blanks
(Done from Column C to R)
Looking for below additions to the above code :
1)Above code pastes code AA or US to rows reflecting FR: only in Column Q. Want the code to paste AA or US to rows reflecting FR: and TO:
2)Column H and I (Template) is updated with Dates in rows reflecting FR: only. Want the macro to update 1st set of dates to rows reflecting FR: and TO: 2nd set of dates to the next row reflecting FR: and TO:
Ex :
Date in Main File (Column B and C)
20150828
20150831
20150328
20150330
Template
FR:
28-Aug-15
31-Aug-15
TO:
28-Aug-15
31-Aug-15
FR:
28-Mar-15
30-Mar-15
TO:
28-Mar-15
30-Mar-15
Attached sample sheet with explanation (DBR Report will give an idea what exactly I want)