Macro - select and paste

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Rashid - 21 May 2006 18:30 GMT

Hi All,

The following is my weekly reconciliation spreadsheet. I need help with a macro to do the following.

A B C D E F G H I
Order# B9 IH Bal Check Qty Kgs $
12709 12,325 0 1,235 X (188) (767) (2117)
98069 50,001 (4,009) 1,024 X (110) (898) (213)
82305 10,310 0 1,030 - 0 0 0

1) Select column A and search for duplicates, if found put and "dup" in column E
2) IF THERE IS "X" IN COLOUMN F THAN MAKE THE ENTIRE ROW BOLD
3) COPY THE ENTIRE ROW DATA FROM column A TO D
4) PASTE ROW DATA (Col A to D) IN SHEET 1
5) ALSO COPY THE CELL Cell A and cell I and paste in colunmn J AND K
6) convert the sign of of the value. That is if negative convert it into positive and vise versa.

THANKS,

RASHID

Reply to this Message

Richard Buttrey - 21 May 2006 21:54 GMT

>Hi All,
>
[quoted text clipped - 10 lines]
>3) COPY THE ENTIRE ROW DATA FROM column A TO D
>4) PASTE ROW DATA (Col A to D) IN SHEET 1

>5) ALSO COPY THE CELL Cell A and cell I and paste in colunmn J AND K
>6) convert the sign of of the value. That is if negative convert it into positive and vise versa.

Re: items 3 to 6. Do you mean just the rows of data where there is an
X in column F?

Re Item 5 & 6, does this refer to the original data rather than the
pasted data on sheet1?

I've assumed the answer to both questions is Yes

One way is:

Sub Tester()
Dim rCell As Range
Dim x As Long
Dim wsData As Worksheet
Range(Range("a2"), Range("a2").End(xlDown)).Offset(0, 4) = _
"=IF(COUNTIF(A:A,A2)>1,""dup"","""")"

Set wsData = Worksheets("data")
For x = 1 To Range(Range("a2"),
Range("a2").End(xlDown)).Rows.Count
wsData.Range("a2").Cells(x, 1).Copy
Destination:=wsData.Range("a2").Cells(x, 10)
wsData.Range("a2").Cells(x, 11) = wsData.Range("a2").Cells(x,
9) * -1
If wsData.Range("F2").Cells(x, 1) = "X" Then
wsData.Range("F2").Cells(x, 1).EntireRow.Font.Bold = True
wsData.Range(wsData.Range("A2").Cells(x, 1),
wsData.Range("A2").Cells(x, 4)).Copy
Worksheets("Sheet1").Activate
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
(xlPasteAll)
End If

Next

End Sub

>THANKS,
>
>RASHID

__
Richard Buttrey
Grappenhall, Cheshire, UK
__________________________

Reply to this Message