Excel 2003 sort macro

I've never built a macro and I have two spreadsheets. One has customer number, customer name and address. The other has customer number, customer type and date. I would like to create a spreadsheet from these two that selects a customer number based on customer type and date then using the selected customer number moves the customer name and address to the third spreadsheet. What would this macro look like?
Who is Participating?
byundtConnect With a Mentor Commented:
The following macro displays an input box requesting what type of customers and what date you want. It then autofilters Sheet1 for those criteria, searches for matching customer ID on Sheet2, then copies Sheet2 columns D:L on that row to Sheet3.
Sub TypeAndDate()
Dim cel As Range, celID As Range, rg As Range, rgCopy As Range, rgDate1 As Range, rgDest As Range, rgID1 As Range, rgID2 As Range, rgType1 As Range
Dim sDate As String, sType As String
Dim dat As Double
Dim i As Long, ncols As Long
sType = InputBox("What customer type do you want?")
If sType = "" Then Exit Sub
sDate = InputBox("What date do you want?")
On Error Resume Next
dat = CDate(sDate)
On Error GoTo 0
If dat = 0 Then Exit Sub

Application.ScreenUpdating = False
With Worksheets("Sheet1")
    If .UsedRange.Row <> 1 Then
        .Cells(1, 1).Value = "ID"
        .Cells(1, 8).Value = "Type"
        .Cells(1, 9).Value = "Date"
    End If
    Set rg = .UsedRange
    Set rgID1 = Intersect(.Columns(1), .UsedRange)
    Set rgType1 = Intersect(.Columns(8), .UsedRange)
    Set rgDate1 = Intersect(.Columns(9), .UsedRange)
End With
With Worksheets("Sheet2")
    Set rgID2 = Intersect(.Columns(2), .UsedRange)
    Set rgCopy = Intersect(.Range("D:L"), .UsedRange)
    ncols = rgCopy.Columns.Count
End With
With Worksheets("Sheet3")
    Set rgDest = .Cells(1, 2)
    i = 1
End With
rg.AutoFilter Field:=8, Criteria1:=sType
rg.AutoFilter Field:=9, Criteria1:=Format(dat, "d-mmm")
Set rgID1 = rgID1.SpecialCells(xlCellTypeVisible)
If rgID1.Cells.Count > 1 Then
    For Each cel In rgID1.Cells
        If cel <> "ID" Then
            Set celID = Nothing
            On Error Resume Next
            Set celID = rgID2.Find(cel.Value)
            On Error GoTo 0
            If Not celID Is Nothing Then
                i = i + 1
                Intersect(celID.EntireRow, rgCopy).Copy rgDest.Cells(i, 1)
            End If
        End If
End If
End Sub

Open in new window

mfraxAuthor Commented:
I have a test workbook with two spreadsheets with faux data.
helpfinderIT ConsultantCommented:
could you post some example, mainly how the 3th sheet should looks like?
mfraxAuthor Commented:
Yes, thanks, I can post without sheet 3 completed also. [embed=file 679844 Test data with results on sheets.]
mfraxAuthor Commented:
Fast and perfect, byundt, you are very smart. Thanks, I will be studying this VB app.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.