Searching multiple columns and returns the values in excel vba

[Kaniguan1969]

Hi,

I have an excel worksheet that contains attendance data. This file came from different users basically all users have a file for attendance records, all of them are the same format and assign/store in one common folder. The first 7 columns are employee info (A to G) while the rest columns start in H column are attendance records which the columns header are date formatted in (dd-mm') days and month.

Right now i have already the excel vba code for one column only and its working but i wanted if it is doable to find/search in multiple column and return the data to another worksheet. basically its a dynamics search depends what particular dates i need to capture.

A to G columns is always included then from H to what ever columns needed to capture. sample need to capture April 1 to april 5 the result is column H to L.. thank you in advance.


sample: raw data
Excel Column:

--------------------1-Apr--2-Apr--3-Apr--4-Apr--5-Apr--6-Apr--7-Apr--8-Apr to 30-Apr

A-B-C-D-E-F-G--H--------I-------J--------K--------L--------M--------N--------O and so on


result:
1-Apr--2-Apr--3-Apr--4-Apr--5-Apr A-B-C-D-E-F-G--H------I--------J ----K------L

Attached is a sample data


Btw, I have an existing thread in other forums http://social.msdn.microsoft.com/Forums/office/en-US/d815810f-8789-4197-a982-d5d95ae4b4c9/searching-multiple-columns-and-returning-the-values-to-another-worksheet-in-excel-vba?forum=exceldev

Thank you,
Jov

[Paul_Hossler]

I made it so that the date columns that had any cell selected were copied, and then the name date columns after that

No need to select the entire column

In case a name col was accidently selected, I removed it from the copy

You can select discontigeous ranges if you want using Control+Click

So in attachment, I selected H4:I4, control key and select L6:N6, and control select AA8:AC8

Ran the macro





Option Explicit
Sub ExtractData()
Dim sExtractWorksheetName As String
Dim rData As Range, rNames As Range, rColumn As Range
Dim iColumn As Long
Dim wsExtract As Worksheet

'make sure a range (e.g. not text box, etc) is selected
If Not TypeOf Selection Is Range Then Exit Sub
With Selection.Parent
Set rNames = Range(.Columns(1), .Columns(7))
'in case something in A - H is selected
Set rData = Range(.Columns(8), .Columns(.Columns.Count))
Set rData = Intersect(rData, Selection.EntireColumn)
'selection does not include data past col H
If rData Is Nothing Then Exit Sub
End With
Application.ScreenUpdating = False
'create new ws, delete if exists
sExtractWorksheetName = Selection.Parent.Name & "-Extract"
Application.DisplayAlerts = False
On Error Resume Next
Worksheets(sExtractWorksheetName).Delete
On Error GoTo 0
Application.DisplayAlerts = True

Worksheets.Add.Name = sExtractWorksheetName
Set wsExtract = Worksheets(sExtractWorksheetName)

'copy the date columns
iColumn = 1
For Each rColumn In rData.Columns
Call rColumn.Copy(wsExtract.Columns(iColumn))
iColumn = iColumn + 1
Next

Call rNames.Copy(wsExtract.Columns(iColumn))
Application.ScreenUpdating = True
Call MsgBox(rData.Address & " from " & rData.Parent.Name & " was copied to " & sExtractWorksheetName, vbInformation + vbOKOnly, "Extract Data")
End Sub

[Kaniguan1969]

Hi Paul,

Thank you very much for your reply. I'm just a little bit puzzled.
Trying to run the macro it displayed and copied the H column together with the column from A to G.
Do i have a manual intervention before running this maco?
It possible to have an input box (textbox) and filled up with dates and and this dates will be using to capture those columns?
I attached the admin working file with userform.

This is the result:

Apri-1 --A--B--C--D--E--F--G

Resutl should be:

A--B--C--D--E--F--G--1-Apr-


Here is the process:

1. attendance monitoring is distributed to 12 users/ different group, they have to enter the daily attendance per group. All those workbook.sheet have the same format and store in a common folder.
2. Admin user have to access those attendance monitoring one by one and consolidate it into the working file using by admin.
3. I wanted to automate capturing those data using macro. Initially I have a macro that capture per column but what if i need to capture multiple columns using the dates (column header). I'm using excel userform indicate with a command buttons per lines. attached is the admin working file.

[snb]

You can easily consolidate the files containing attendance data using databasequeries.

[Paul_Hossler]

I made it so that the date columns that had any cell selected were copied, and then the name date columns after that
So in attachment, I selected H4:I4, control key and select L6:N6, and control select AA8:AC8
Ran the macro


I didn't do anything about consolidating multiple workbooks

I only set it up to create a new worksheet by copying the selected date column(s) starting to col A on the sheet, and then the name columns at the end

The way you wanted to selected date columns was not defined, so I made it user driven: select a range of date cells or columns and then run the macro to copy the selected date columns and then the name data columns

The way I read your #1 ....



result:

1-Apr--2-Apr--3-Apr--4-Apr--5-Apr A-B-C-D-E-F-G--H------I--------J ----K------L


I thought you wanted the selected dates first then the name data


But your #3 says



Resutl should be:

A--B--C--D--E--F--G--1-Apr-



so I'm confused as to what you are looking for

In the attachment, if you select the cells in red and run the macro, it makes a new sheet with the data re-arranged

[Kaniguan1969]

Sorry Paul. I have a mistake in #1. it should be #3. anyway, I have attached the screen shot with dynamic range based on the content of texboxes.
for example of my raw data: if my textbox contain startdate 1-May and end date 4-May, the range from H to L should be selected and copy all the transaction that belong to these columns including the A to G columns to the working file .

There's a button in the userform that contains the Lines. every line have different users and attendance monitoring but the format is all the same.
all the transaction entered by the users will consolidate into one working file.

A---------------B-------C-----D-----E------F----------G--------H-------J-------K-------L------M------N
Username--fisrnname--desc--code--area--process--supname---1-May--2-May--3-May--4-May--5-May--6-May

Result
A---------------B-------C-----D-----E------F----------G--------H-------J-------K-------L---
Username--fisrnname--desc--code--area--process--supname---1-May--2-May--3-May--4-May

[Kaniguan1969]

Hi,

I just come up a solution but my macro code throws out an error.
It says that this command cannot be use in multiple selection. thanks.


Dim wb As Workbook
Dim ws As Worksheet, wsTemp As Worksheet
Dim rng1 As Range, rng2 As Range, StaticRng As Range, DynamicRng As Range, _
MultipleRng As Range, Target As Range
Dim StartDate As String, EndDate As String
Dim Lrow As Long, i As Long
Set wsTemp = Sheet1
Set ws = Sheet3
StartDate = "2-May"
EndDate = "6-May"

With ThisWorkbook.Worksheets("Sheet1").Range("A1:AZ100")
Lrow = .Range("A1" & .Rows.Count).End(xlUp).Row
Set StaticRng = .Range("A1:G" & Lrow) ' Result $A$1:$G$33
'~~> code to get startDate and endDate
Set rng1 = .Find(What:=StartDate, LookIn:=xlValues, lookat:=xlWhole)
Set rng2 = .Find(What:=EndDate, LookIn:=xlValues, lookat:=xlWhole)

Set DynamicRng = .Range(rng1.Address, rng1.Address).Resize(Lrow)

'~~> combined staticRng and DynamicRng
Set MultipleRng = Union(StaticRng, DynamicRng) 'Result $I$2:$I$34 $A$1:$G$33,$I$2:$I$34

'~~> This portion throws an error "This command cannot be use on multiple selection"
MultipleRng.Copy
MultipleRng.Offset(1, 0).Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)

End With

[Kaniguan1969]

Solved.

Here is the code:


With wsUPH
Lrow = .Range("A" & Rows.Count).End(xlUp).Row
Set rng = wsUPH.Range("H2:AZ2")
Set rng1 = rng.Find(StartDate, , xlValues, xlWhole)
Set rng2 = rng.Find(EndDate, , xlValues, xlWhole)
Set Startrange = wsUPH.Range(Cells(2, 1), Cells(2, 7)).Resize(Lrow) '
Set Targetrange = wsUPH.Range(Cells(2, rng1.Column), Cells(2, rng2.Column)).Resize(Lrow)
Set MultipleRange = Union(Startrange, Targetrange)

Debug.Print rng1.Address, rng2.Address
Debug.Print Startrange.Address, Targetrange.Address
Debug.Print MultipleRange.Address

If ws.Range("A2") <> "" Then
MultipleRange.Offset(2, 0).Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
Else
MultipleRange.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
End If
End With