You are here:

Excel/VBA code to extract.

Advertisement


Question
QUESTION: Dear Sir,

Hope you are fine.

I have below VBA code to extract the data which is working fine, i have number of things to add, appreciate if you could help us.

1) currenly code is extracting from only one sheet, now i have number of sheets used by different user eg:- saad, sujada. and wanted to extract from all the sheet to sheet Extract one by one.

2)only to extract if data in the B9:B200 in the user sheet equal to or lessthan to D6 in the sheet extract. it date format (mmm-yy)

3)currently it is extracting same row many times, i wanted to extract unique roq . in the C9:C200 is job task to complete and B9:B200 is mmm-yy.



Sub Extractgeorge()
Dim r As Range, sh As Worksheet
Set r = Worksheets("george").Range("H9:AD200")
Set sh = Worksheets("Extract")
For Each cell In r
If UCase(cell.Value) <> "Y" Then
rw = sh.Cells(sh.Rows.Count, "C").End(xlUp).Row + 1
cell.EntireRow.Copy
If rw < 18 Then rw = 18
sh.Cells(rw, 1).PasteSpecial xlValues
sh.Cells(rw, 1).PasteSpecial xlFormats
End If
Next
End Sub

Thanks
Abdul Jaleel

ANSWER: abdul,

you have to code looping through all cells in the range H9:AD200.  so every row is visited for the number of columns.  Since I know nothing about your data, I really can't say why you are doing that or what condition you are looking for.  Right now it copies the row each time if finds a cell between column H and column AD that does not contain a "y" in it.


So you would need to change the condition and only loop down one column.  If column B is the key column then use that


you say column B in each sheet and D6 in the extract sheet contains cells formatted with the same date format displaying the month and year.  So I assume those cells contain actual Excel dates.  


Sub ExtractData()
Dim r As Range, sh As Worksheet, sh1 As Worksheet
Dim cell As Range, rDate As Range, v As Variant
Dim dt As Date, i As Long, rw As Long
v = Array("George", "saad", "sujada")
Set sh = Worksheets("Extract")
Set rDate = sh.Range("D6")
' dt will hold the date of the last day of the month for the date in D6
dt = DateSerial(Year(rDate), Month(rDate) + 1, 0)
For i = LBound(v) To UBound(v)
Set sh1 = Worksheets(v(i))
Set r = sh1.Range("B9:B200")

For Each cell In r
If cell <= dt Then
rw = sh.Cells(sh.Rows.Count, "C").End(xlUp).Row + 1
cell.EntireRow.Copy
If rw < 18 Then rw = 18
sh.Cells(rw, 1).PasteSpecial xlValues
sh.Cells(rw, 1).PasteSpecial xlFormats
End If
Next cell
Next i
End Sub

so the only condition I am enforcing is if the date in column B on a name sheet is less than or equal to the month and year of the date in D6 of the extract sheet.

If you need to enforce another condition, you would have to spell that out.

if you still have a need for the first code without copying rows multiple time then spell out specificially what the condition is to copy the row.

--
Regards,
Tom Ogilvy


---------- FOLLOW-UP ----------

QUESTION: Dear Sir,

Even without seeing my data, it is alsmost working the way i want in the new code. i need two more thing.

1)It only to extract if any of cell in H9:AD200 <> "Y"( entire row to extract if condition match).

2) in the user sheet, rows belong to current month will visible rest month will be hidden. i wanted to extract from hidden rows also if condion match ( B9:B200 >= D6 sheet extract and H9:AD200 <> "y").

this workbook is check list,each user will be using different sheet to update their work, if work done cell will change to "Y". admin will be coming in sheet Extract and extract all pending task.

Thanks
Abdul

Answer
Abdul,

>1)It only to extract if any of cell in H9:AD200 <> "Y"( entire row to extract if condition match).

I assume by that you mean for that particular row.  For example, if I am processing B12 on the user's sheet, then I check for any cell in the range H12:AD12 not having a "y" in it (including blank cells).  That is the way I have programmed it.  If that isn't correct, post a followup.

Sub ExtractData()
Dim r As Range, sh As Worksheet, sh1 As Worksheet
Dim cell As Range, rDate As Range, v As Variant
Dim dt As Date, i As Long, rw As Long
Dim cell1 As Range, bHidden As Boolean
v = Array("George", "saad", "sujada")
Set sh = Worksheets("Extract")
Set rDate = sh.Range("D6")
' dt will hold the date of the last day of the month for the date in D6
dt = DateSerial(Year(rDate), Month(rDate) + 1, 0)
For i = LBound(v) To UBound(v)
Set sh1 = Worksheets(v(i))
Set r = sh1.Range("B9:B200")

For Each cell In r
bHidden = False
Set cell1 = cell.Offset(0, 6).Resize(1, 23) ' H:AD
If cell <= dt Then
If Application.CountIf(cell1, "<>y") > 0 Then
rw = sh.Cells(sh.Rows.Count, "C").End(xlUp).Row + 1
If cell.EntireRow.Hidden = True Then bHidden = True
cell.EntireRow.Hidden = False
cell.EntireRow.Copy
If rw < 18 Then rw = 18
sh.Cells(rw, 1).PasteSpecial xlValues
sh.Cells(rw, 1).PasteSpecial xlFormats
End If
If bHidden = True Then cell.EntireRow.Hidden = True
End If
Next cell
Next i
End Sub

--
Regards,
Tom Ogilvy

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.