Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
I have received plenty of help from here with several macro's
attempting to solve my problem. But the problem was never resolved. Most of it is my fault. After reviewing the macro's and my original description of my problem, I am trying to make another post that might actually solve my problem. The last attempt worked ok except for the fact I left part of the end results of the previous macro on my sheet 1. (read below) After the sort, it was reading the data at the bottom of sheet 1:col B and placing it on Sheet 4. And that data was used to come up with a solution. When I deleted the data:Col B from the other Macro, there was no Col B data on Sheet 4 when the final macro(below) was ran. After chatting with one of the MVP's. Here is what I need: VLookup will not work because it will only return 1 item. I have multiple items for 1 match in most cases. Example: 1 employee might have 4 id's. I have a file if someone wants it. For each item in col A of sheet2 I want to look for a match in col A of sheet 1. If there is a match I want(all)="that cell"="that item" of the row:col B of Sheet2 copied to Col B sheet 4. Etc I then want? This is the tricky part: For each item in col A of sheet2 I want to look for a match in col A of sheet 1. If there is a match I want(all) of the row:col C to col P of Sheet1 copied to sheet 3. In other words: I want info from sheet 1 cells in Col A that match cells A:B in Sheet 2_____ to be put in sheet 4. I want info from sheet 1 cells in Col C to Col P that match cells A: in Sheet 4_____ to be put in sheet 4 where? in col C to col P. Here is the last piece of code but I know everyone writes differently: Option Explicit Sub MakeDestinationSheet() Dim n Dim c Dim lr, slr, ifshtlr As Long Dim srcsht, ifsht, destsht As Worksheet Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Set srcsht = Sheets("sheet1") Set ifsht = Sheets("sheet2") ifshtlr = ifsht.Cells(Rows.Count, 1).End(xlUp).Row Set destsht = Sheets("Sheet4") destsht.Select With destsht lr = .Cells(Rows.Count, 1).End(xlUp).Row ..Rows(2).Resize(lr).Delete For Each n In ifsht.Range("a2:a" & ifshtlr) Set c = destsht.Columns(1).Find(n, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False) If c Is Nothing Then slr = srcsht.Cells(Rows.Count, 1).End(xlUp).Row With srcsht.Range("A4:p" & slr) .AutoFilter Field:=1, Criteria1:=n lr = destsht.Cells(Rows.Count, 1).End(xlUp).Row + 1 slr = srcsht.Cells(Rows.Count, 1).End(xlUp).Row srcsht.Range("a5:p" & slr).Copy destsht.Cells(lr, 1) ..AutoFilter End With End If Next n .Range(Cells(2, "c"), Cells(lr + 1, "p")).SpecialCells (xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C" .Range(Cells(2, "j"), Cells(lr + 1, "k")).NumberFormat = "mm/dd/yyyy" .Range(Cells(2, "c"), Cells(lr + 1, "p")).Value = _ .Range(Cells(2, "c"), Cells(lr + 1, "p")).Value .Columns("b").SpecialCells(xlCellTypeBlanks).Entir eRow.Delete .Columns("L").Style = "Comma" .Columns.AutoFit End With Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub Warm regards, Ty |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
One sheet is scrolling 3500 per inch moved | Excel Discussion (Misc queries) | |||
Can the sheet tabs be moved from the bottom to the side... ? | Excel Discussion (Misc queries) | |||
Moved data to new sheet based on list selection | Excel Worksheet Functions | |||
auto file path update when excel sheet moved to another directory. | Excel Discussion (Misc queries) | |||
Inserting a row in sheet A should Insert a row in sheet B, removing a row in Sheet A should remove the corresponding row in sheet B | Excel Programming |