Extract Data and Create Reports Automatically in Excel

N

nabeelahmed

Board Regular
Joined
Jun 19, 2020
Messages
76
Office Version
  1. 365
Platform
  1. Windows
Dear Friends, I want to prepare a report with data extract from other sheet with the help of VBA coding. I have attached two sheets one is showing data and the other is showing format what i want to use in that 2nd sheet i want that if i enter Customer Id in Cell F3 and will get data of that specific customer and after that if i want to filter data with specific range i just have to enter date ranges. Please help me to create this report.

1593836102171.png


1593836148643.png
 
Sort by date Sort by votes
vcoolio said:
Sorry Nabeel,

I just found a couple of typos in the code above so here it is again:-

VBA Code: 
Option Explicit
Sub Test()

        Dim wsR As Worksheet: Set wsR = Sheets("Report ")
        Dim wsD As Worksheet: Set wsD = Sheets("Data")
        Dim CustID As String: CustID = wsR.[F3].Value
        Dim FromDt As Long: FromDt = wsR.[C3].Value
        Dim ToDt As Long: ToDt = wsR.[D3].Value
        Dim cAr As Variant, pAr As Variant, nRow As Long, x As Long
        Dim lr As Long: lr = wsD.Range("A" & Rows.Count).End(xlUp).Row
       
        cAr = Array("A8:A" & lr, "B8:B" & lr, "D8:D" & lr, "E8:E" & lr, "G8:G" & lr, "I8:I" & lr, "J8:J" & lr, _
        "K8:K" & lr, "Z8:Z" & lr, "AC8:AC" & lr, "AD8:AD" & lr, "AE8:AE" & lr, "AJ8:AJ" & lr, "AO8:AO" & lr)
        pAr = Array("A", "G", "L", "B", "E", "F", "D", "C", "H", "I", "J", "K", "M", "N")
       
        nRow = wsR.Cells(Rows.Count, 1).End(xlUp).Row + 1
       
Application.ScreenUpdating = False

If wsR.Range("C3,D3,F3") = vbNullString Then Exit Sub

With wsD.[A7].CurrentRegion
        .AutoFilter 11, CustID
        With .Offset(1)
        .AutoFilter 5, ">=" & FromDt, xlAnd, "<=" & ToDt
For x = LBound(cAr) To UBound(cAr)
        wsD.Range(cAr(x)).Copy
        wsR.Range(pAr(x) & nRow).PasteSpecial xlValues
Next x
        .AutoFilter
        End With
End With
       
        wsR.Range("A8:N500").Borders.Weight = xlThin
        wsR.Columns.AutoFit
        wsR.[C3:F3].ClearContents
       
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Please ensure that you manually enter the column headings in the Report sheet. As these need to be there permanently, there is no need for them to be brought over from the Data sheet with each transfer of data.
In the Data sheet, please ensure that Row6 is completely cleared of any data. I believe that you only put data in this row for my reference.


Cheerio,
vcoolio.
Click to expand...
Dear Vcoolio, Thank you for your working.. everything is ok but few things are not working as per my requirement as it was working with previous coding.
1- I don't want to clear border of report sheet C3:F3 i just want to clear data every time.
2- I want to clear all data including which is being extracted when i enter next customer id to get next customer data.only current customer id data should be appeared rather than adding to the next rows.
3- Border should be shown for the extracted data only not on all range A8:N500.
4- Regarding Sr # if its possible to auto arrange A to Z when data is extracted in report sheet,please do it.

Thanks and appreciate your support

Nabeel
 
Upvote 0

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Hello Nabeel,

Here is the code again with some minor amendments:-

VBA Code: 
Option Explicit
Sub Test()

        Dim wsR As Worksheet: Set wsR = Sheets("Report ")
        Dim wsD As Worksheet: Set wsD = Sheets("Data")
        Dim CustID As String: CustID = wsR.[F3].Value
        Dim FromDt As Long: FromDt = wsR.[C3].Value
        Dim ToDt As Long: ToDt = wsR.[D3].Value
        Dim cAr As Variant, pAr As Variant, nRow As Long, x As Long
        Dim lr As Long: lr = wsD.Range("A" & Rows.Count).End(xlUp).Row
        Dim lrR As Long: lrR = wsR.Range("A" & Rows.Count).End(xlUp).Row
        
        cAr = Array("A8:A" & lr, "B8:B" & lr, "D8:D" & lr, "E8:E" & lr, "G8:G" & lr, "I8:I" & lr, "J8:J" & lr, _
        "K8:K" & lr, "Z8:Z" & lr, "AC8:AC" & lr, "AD8:AD" & lr, "AE8:AE" & lr, "AJ8:AJ" & lr, "AO8:AO" & lr)
        pAr = Array("A", "G", "L", "B", "E", "F", "D", "C", "H", "I", "J", "K", "M", "N")
        
        If lrR < 8 Then lrR = 8
        wsR.Range("A8:N" & lrR).Delete
        nRow = wsR.Cells(Rows.Count, 1).End(xlUp).Row + 1
          
Application.ScreenUpdating = False
 
        If wsR.Range("C3,D3,F3") = vbNullString Then Exit Sub

With wsD.[A7].CurrentRegion
        .AutoFilter 11, CustID
        With .Offset(1)
        .AutoFilter 5, ">=" & FromDt, xlAnd, "<=" & ToDt
For x = LBound(cAr) To UBound(cAr)
        wsD.Range(cAr(x)).Copy
        wsR.Range(pAr(x) & nRow).PasteSpecial xlValues
Next x
        .AutoFilter
        End With
End With
        
        wsR.Range("A8", wsR.Range("N" & wsR.Rows.Count).End(xlUp)).Borders.Weight = xlThin
        wsR.Range("A8", wsR.Range("N" & wsR.Rows.Count).End(xlUp)).Sort wsR.[A8], 1
        wsR.Columns.AutoFit
        wsR.[C3:F3].ClearContents
        
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub
Rich (BB code): 
1- I don't want to clear border of report sheet C3:F3 i just want to clear data every time.

This is not happening in the sample that you supplied me. This line of code:-

VBA Code: 
wsR.[C3:F3].ClearContents

clears the contents only of the range C3:F3. If it were as follows:-

VBA Code: 
wsR.[C3:F3].Clear

it would clear everything including the borders.
It could be a formatting problem in your actual workbook.

I hope that this helps.

Cheerio,
vcoolio.
 
Upvote 0
vcoolio said:
Hello Nabeel,

Here is the code again with some minor amendments:-

VBA Code: 
Option Explicit
Sub Test()

        Dim wsR As Worksheet: Set wsR = Sheets("Report ")
        Dim wsD As Worksheet: Set wsD = Sheets("Data")
        Dim CustID As String: CustID = wsR.[F3].Value
        Dim FromDt As Long: FromDt = wsR.[C3].Value
        Dim ToDt As Long: ToDt = wsR.[D3].Value
        Dim cAr As Variant, pAr As Variant, nRow As Long, x As Long
        Dim lr As Long: lr = wsD.Range("A" & Rows.Count).End(xlUp).Row
        Dim lrR As Long: lrR = wsR.Range("A" & Rows.Count).End(xlUp).Row
       
        cAr = Array("A8:A" & lr, "B8:B" & lr, "D8:D" & lr, "E8:E" & lr, "G8:G" & lr, "I8:I" & lr, "J8:J" & lr, _
        "K8:K" & lr, "Z8:Z" & lr, "AC8:AC" & lr, "AD8:AD" & lr, "AE8:AE" & lr, "AJ8:AJ" & lr, "AO8:AO" & lr)
        pAr = Array("A", "G", "L", "B", "E", "F", "D", "C", "H", "I", "J", "K", "M", "N")
       
        If lrR < 8 Then lrR = 8
        wsR.Range("A8:N" & lrR).Delete
        nRow = wsR.Cells(Rows.Count, 1).End(xlUp).Row + 1
         
Application.ScreenUpdating = False

        If wsR.Range("C3,D3,F3") = vbNullString Then Exit Sub

With wsD.[A7].CurrentRegion
        .AutoFilter 11, CustID
        With .Offset(1)
        .AutoFilter 5, ">=" & FromDt, xlAnd, "<=" & ToDt
For x = LBound(cAr) To UBound(cAr)
        wsD.Range(cAr(x)).Copy
        wsR.Range(pAr(x) & nRow).PasteSpecial xlValues
Next x
        .AutoFilter
        End With
End With
       
        wsR.Range("A8", wsR.Range("N" & wsR.Rows.Count).End(xlUp)).Borders.Weight = xlThin
        wsR.Range("A8", wsR.Range("N" & wsR.Rows.Count).End(xlUp)).Sort wsR.[A8], 1
        wsR.Columns.AutoFit
        wsR.[C3:F3].ClearContents
       
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub
Rich (BB code): 
1- I don't want to clear border of report sheet C3:F3 i just want to clear data every time.

This is not happening in the sample that you supplied me. This line of code:-

VBA Code: 
wsR.[C3:F3].ClearContents

clears the contents only of the range C3:F3. If it were as follows:-

VBA Code: 
wsR.[C3:F3].Clear

it would clear everything including the borders.
It could be a formatting problem in your actual workbook.

I hope that this helps.

Cheerio,
vcoolio.
Click to expand...
Dear Vcoolio, Thank you very much for giving your valuable time and support. :)
 
Upvote 0
You're welcome Nabeel. I'm glad to have been able to assist. I hope that its all working for you now.

Just one more thing if you'd care to do it:-

Remove this line of code from its current position:-

VBA Code: 
If wsR.Range("C3,D3,F3") = vbNullString Then Exit Sub

and place it directly above the cAr = Array(.................) line of code.

This will make this particular procedure more efficient.

Cheerio,
vcoolio.
 
Upvote 0
Dear Vcoolio , Hi hope you will be fine, Would you please help me for below attached sheet, I have mentioned my requirement in Sheet2 . Please check if you can help me for the same.



we.tl

Stock sheet Working.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world
we.tl we.tl
 
Upvote 0
Hello Nabeel,

As this is a new topic, could you please start a new thread for it. This thread is long enough on its own.

Thank you Nabeel.

Cheerio,
vcoolio.
 
Upvote 0
vcoolio said:
Hello Nabeel,

As this is a new topic, could you please start a new thread for it. This thread is long enough on its own.

Thank you Nabeel.

Cheerio,
vcoolio.
Click to expand...

Hi Vcoolio. Below is new thread

www.mrexcel.com

Extract & Enter Data in excel

Hi Friend, Can somebody help me for below attached file, I have mentioned in sheet 2 what i required. https://we.tl/t-v5ZrI5uCoD
www.mrexcel.com www.mrexcel.com
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question
data extract between sheets For the value entered
Replies
1
Views
136
LazyBug
LazyBug
M
  • Question
Exception report in Excel
Replies
2
Views
130
mmarc2000
M
F
  • Question
Extracting specific data to populate specific blocks in excel sheet.
Replies
0
Views
470
flintwc64
F
Q
  • Question
Automate missing cell value report
Replies
2
Views
111
mumps
mumps
D
  • Question
Excel Numbering - (O365)
2
Replies
11
Views
371
dgoodrid
D

Forum statistics

Threads
1,214,618
Messages
6,120,544
Members
448,970
Latest member
kennimack

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top