T
Ty
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
" & 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" & 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).EntireRow.Delete
.Columns("L").Style = "Comma"
.Columns.AutoFit
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Warm regards,
Ty
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
" & 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
" & 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).EntireRow.Delete
.Columns("L").Style = "Comma"
.Columns.AutoFit
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Warm regards,
Ty