conditional copy and paste

[TUNGANA KURMA RAJU]

I need code to copy all the rows that contain value "May-09"(this is variable
say sheet3!a1 value) of sheet1 and paste them to last row of sheet2

 

[Jacob Skaria]

Raju

The below macro should copy the rows from Sheet1 to Sheet2 if Col A of
Sheet1 matches with the entry given in Sheet3A1. Sheet1 Col A and Sheet3 cell
A1 entries should be in Date format...

Sub Macro()
Dim wb As Workbook
Dim varFind As Variant
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lngRow As Long
Dim lngLastRow1 As Long, lngLastRow2 As Long

Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("Sheet1")
Set ws2 = wb.Sheets("Sheet2")
varFind = Format(wb.Sheets("Sheet3").Range("A1"), "mmmyy")

lngLastRow1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row
lngLastRow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row

For lngRow = 1 To lngLastRow1
If Format(ws1.Range("A" & lngRow), "mmmyy") = "May09" Then
ws1.Rows(lngRow).Copy ws2.Rows(lngLastRow2 + 1)
lngLastRow2 = lngLastRow2 + 1
End If
Next
End Sub


If this post helps click Yes

 

[TUNGANA KURMA RAJU]

Thank you Jacob,the macro is giving slight wrong output.Its copying matching
rows twice to Sheet2.can you please correct it,please.

 

[Jacob Skaria]

Can you just confirm as I dont see an error.

 

[TUNGANA KURMA RAJU]

yes Sir,
Its copying twice or may be looping twice.

 

[Jacob Skaria]

Hi Raju

There is something wrong in the way you are trying. Below is the test i did.
I would really like to what is going wrong, Please try and feedback

1. Open new workbook. Launch VBE using Alt+F11. From menu Insert a module
and paste the code.

2. On sheet1 Col A and B I have put the below values. Col A is in date
format inserted and edited using (Ctrl+Semicolon).

6/8/2009 0
6/8/2009 0
5/8/2009 1
5/8/2009 2
6/8/2009 0
6/8/2009 0

3. In Sheet 3 Cell A1 I have placed a date which is in May 5/8/2009. I
expected the two records to be copied to Sheet2; the values of which in ColB
are 1 and 2

4. Run the macro and see.

 

[Eddy Stan]

Hi Jacob,
The sample was useful to some extent.
It tells how to copy whole row. But i need to copy only 5 columns.
One sheet has 25 search strings
Each string has to be searched in "tranaction sheet" at c column (has 800
rows)
and for matching c - copy c:h and place it in new sheet (next to title with
range name:= "report title") from b to g (h to k has ageing, so not to over
write cells next to h till k column)
all 25 strings have to be searched from begining to end and copied data to
be placed in new sheet. Sheet name must be with search string.
can you please help on this.

 

[Don Guillett]

Since you did NOT append to the earlier posts, hard to tell .
If desired, send your file to my address below along with this msg and
a clear explanation of what you want and before/after examples.

 

[Eddy Stan]

Hi Don,
I got code for my ealier question ages back, from Mr Tom Ogilvy (thanks Mr
Tom)
under caption: VB Code please
I am useing that code and i using fuction formula to show ageing.
but is it possible to insert ageing formula in macro. pl help.
my code as follows.
Sub ProcessData2()
Dim sh1 As Worksheet, sh As Worksheet
Dim Loc_b3, Veh_c3, dtStart As Date, dtend As Date
Dim cell As Range, rng As Range, rw As Long
Dim Frsum As Long, costsum As Long
Set sh1 = Worksheets(1) ' base sheet, where i would show my data gathered
Set sh = Worksheets(Range("b3").Value) ' Worksheets("dat1")
Loc_b3 = sh1.Range("B1")
Veh_c3 = sh1.Range("B2")
dtStart = sh1.Range("D1")
dtend = sh1.Range("D2")
sh1.Range("a7:J500").Clear ' ClearContents
rw = 7
Frsum = 0
costsum = 0

Application.ScreenUpdating = False

' For Each sh In Worksheets
' If sh.Name <> sh1.Name Then
Set rng = sh.Range(sh.Cells(2, 1), sh.Cells(Rows.Count, 1).End(xlUp))
For Each cell In rng
If cell.Offset(0, 2) = Loc_b3 And _
cell.Offset(0, 17) = Veh_c3 And _
cell.Offset(0, 10) >= dtStart And _
cell.Offset(0, 10) <= dtend Then
' sh1.Cells(rw, 1) = cell.Offset(0, 0) ' region
sh1.Cells(rw, 2) = cell.Offset(0, 1) ' branch
sh1.Cells(rw, 3) = cell.Offset(0, 2) ' destination
sh1.Cells(rw, 4) = cell.Offset(0, 5) ' customer name
sh1.Cells(rw, 5) = cell.Offset(0, 9) ' Gcn No
sh1.Cells(rw, 6) = cell.Offset(0, 10) ' Date
sh1.Cells(rw, 7) = cell.Offset(0, 12) ' Lhps No
sh1.Cells(rw, 8) = cell.Offset(0, 17) ' broker name
sh1.Cells(rw, 9) = cell.Offset(0, 29) ' Freight
sh1.Cells(rw, 10) = cell.Offset(0, 36) ' Cost
rw = rw + 1
Frsum = Frsum + cell.Offset(0, 29)
costsum = costsum + cell.Offset(0, 36)
End If
sh1.Cells(rw, 8) = "Total"
sh1.Cells(rw, 9) = Frsum
sh1.Cells(rw, 10) = costsum
Next cell ' cell range (next sheet)
'ActiveCell.Select

' Little formatting
sh1.Range(sh1.Cells(rw, 2), sh1.Cells(rw, 10)).Select
Selection.Interior.ColorIndex = 33
Selection.Font.ColorIndex = 11
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
rw = rw + 1
' End If

Frsum = 0
costsum = 0

'Next sh

Range("e1").Select
Application.ScreenUpdating = True

End Sub

' I am sending my file for you as advised.

 

[Eddy Stan]

i am waiting..
any body else can help me

Hi Don,
I got code for my ealier question ages back, from Mr Tom Ogilvy (thanks Mr
Tom)
under caption: VB Code please
I am useing that code and i using fuction formula to show ageing.
but is it possible to insert ageing formula in macro. pl help.
my code as follows.
Sub ProcessData2()
Dim sh1 As Worksheet, sh As Worksheet
Dim Loc_b3, Veh_c3, dtStart As Date, dtend As Date
Dim cell As Range, rng As Range, rw As Long
Dim Frsum As Long, costsum As Long
Set sh1 = Worksheets(1) ' base sheet, where i would show my data gathered
Set sh = Worksheets(Range("b3").Value) ' Worksheets("dat1")
Loc_b3 = sh1.Range("B1")
Veh_c3 = sh1.Range("B2")
dtStart = sh1.Range("D1")
dtend = sh1.Range("D2")
sh1.Range("a7:J500").Clear ' ClearContents
rw = 7
Frsum = 0
costsum = 0

Application.ScreenUpdating = False

' For Each sh In Worksheets
' If sh.Name <> sh1.Name Then
Set rng = sh.Range(sh.Cells(2, 1), sh.Cells(Rows.Count, 1).End(xlUp))
For Each cell In rng
If cell.Offset(0, 2) = Loc_b3 And _
cell.Offset(0, 17) = Veh_c3 And _
cell.Offset(0, 10) >= dtStart And _
cell.Offset(0, 10) <= dtend Then
' sh1.Cells(rw, 1) = cell.Offset(0, 0) ' region
sh1.Cells(rw, 2) = cell.Offset(0, 1) ' branch
sh1.Cells(rw, 3) = cell.Offset(0, 2) ' destination
sh1.Cells(rw, 4) = cell.Offset(0, 5) ' customer name
sh1.Cells(rw, 5) = cell.Offset(0, 9) ' Gcn No
sh1.Cells(rw, 6) = cell.Offset(0, 10) ' Date
sh1.Cells(rw, 7) = cell.Offset(0, 12) ' Lhps No
sh1.Cells(rw, 8) = cell.Offset(0, 17) ' broker name
sh1.Cells(rw, 9) = cell.Offset(0, 29) ' Freight
sh1.Cells(rw, 10) = cell.Offset(0, 36) ' Cost
rw = rw + 1
Frsum = Frsum + cell.Offset(0, 29)
costsum = costsum + cell.Offset(0, 36)
End If
sh1.Cells(rw, 8) = "Total"
sh1.Cells(rw, 9) = Frsum
sh1.Cells(rw, 10) = costsum
Next cell ' cell range (next sheet)
'ActiveCell.Select

' Little formatting
sh1.Range(sh1.Cells(rw, 2), sh1.Cells(rw, 10)).Select
Selection.Interior.ColorIndex = 33
Selection.Font.ColorIndex = 11
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
rw = rw + 1
' End If

Frsum = 0
costsum = 0

'Next sh

Range("e1").Select
Application.ScreenUpdating = True

End Sub

' I am sending my file for you as advised.

 

[Don Guillett]

Didn't get your file.??? Did you send to (e-mail address removed)

 

[Eddy Stan]

Hi Don,
my mail id (e-mail address removed)
send me a test mail and i will reply with attachment