Macro to copy certain cells in row

Microsoft Excel 2003 (full)
March 10, 2010 at 07:54:33
Specs: Windows XP
I have a workbook with several worksheets. One is called BaseBid. I need a macro which will look at the values in columns J and K. If there is an "x" in column J, I want to copy the values from columns C and D of that row into the last row of a sheet called SL. If there is an "x" in column K, then I want to copy the values from columns C and G of that row into the last row of the SL worksheet. The data on the BaseBid sheet starts in row 6.

I have two macros which almost do what I want. The first copies the values from the right cells on BaseBid to SL. But it does not go through the whole BaseBid sheet, which I need it to do. The second one uses a loop, and it does go through the whole spreadsheet, but it is copying the entire line instead of just the cells I need. Can someone please help? I am pasting the code for both macros below.

Sub InsertSL()
Dim LastRow As Long
Dim rng As Range
LastRow = Last(1, rng)
rng.Parent.Cells(LastRow + 1, 2).Value = "=BaseBid!RC[1]"
rng.Parent.Cells(LastRow + 1, 4).Value = "=SUM(BaseBid!RC[2],BaseBid!RC[5])"

End Sub

Sub test2()

Set a = Sheets("BaseBid")
Set b = Sheets("SL")
Dim x
Dim z

x = 1
z = 6

Do Until IsEmpty(a.Range("I" & z))

If a.Range("J" & z) = "x" Then
x = x + 1
b.Rows(x).Value = a.Rows(z).Value

Else

If a.Range("K" & z) = "x" Then
x = x + 1
b.Rows(x).Value = a.Rows(z).Value

End If
End If
z = z + 1
Loop
End Sub


See More: Macro to copy certain cells in row

Report •


#1
March 10, 2010 at 08:05:50
There must be something you aren't telling us.

What is this Last function that you are using?

Where are you telling VBA what rng is?

LastRow = Last(1, rng)


Report •

#2
March 10, 2010 at 08:16:16
The Last function is this:

Function Last(choice As Long, rng As Range)
Dim lrw As Long
Dim lcol As Long

Select Case choice

Case 1:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0

Case 2:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0

Case 3:
On Error Resume Next
lrw = rng.Find(What:="*", _
After:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0

On Error Resume Next
lcol = rng.Find(What:="*", _
After:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0

On Error Resume Next
Last = rng.Parent.Cells(lrw, lcol).Address(False, False)
If Err.Number > 0 Then
Last = rng.Cells(1).Address(False, False)
Err.Clear
End If
On Error GoTo 0

End Select
End Function


Report •

#3
March 10, 2010 at 09:49:08
Hi,

The following macro takes all the rows on the BaseBid worksheet, based on finding the last cell in column A that contains data, and starting at row 2 (this can be changed in the code at this line:

'set start of source data in column A
Set rngStart = Worksheets("BaseBid").Range("A2")

It looks for a marker in columns J and K - you used x and * in your post - but just set what you need in this line:
'setup the character used as a marker
strMrkr = "x"

The code finds the first empty row on the SL worksheet by searching column A for the last cell with data in it and moving to the next row.

When markers are found either columns C and D are copied or columns C and G
They are copied to the next row on worksheet SL and the destination row offset is incremented.

I didn't know what columns in the SL sheet are used for the copied data - so I used columns A and B.
These can be changed in this code which appears four times:

Destination:=rngDest.Offset(intDestOffset, 0)
The zero is the column offset 0=column A

If you don't paste into column A of the destination SL worksheet, and column A is does not contain data for each used row, then a different approach to finding the last used row on the SL worksheet will be required.

Here is the code:

Option Explicit

Sub MoveMarkedBids()
Dim strMrkr As String
Dim rngStart As Range
Dim rngEnd As Range
Dim rngCell As Range
Dim rngDest As Range
Dim intDestOffset As Integer

On Error GoTo ErrHnd

'turn off screen updating to stop flicker
Application.ScreenUpdating = False

'setup the character used as a marker
strMrkr = "x"

'set start of source data in column A
Set rngStart = Worksheets("BaseBid").Range("A2")

'set end of BaseBid data in column A
Set rngEnd = Worksheets("BaseBid").Range("A" & CStr(Application.Rows.Count)). _
                End(xlUp)

'Set first unused row in SL
Set rngDest = Worksheets("SL").Range("A" & CStr(Application.Rows.Count)). _
                End(xlUp).Offset(1, 0)

'set destination row offset counter
intDestOffset = 0

'search all used data range on BaseBid worksheet and find marker 
'in either col J(10) or col K(11)
For Each rngCell In Range(rngStart, rngEnd)
    If rngCell.Offset(0, 9).Text = strMrkr Then
        'x in J so copy cells in columns C(3) and D(4) - offset value is one less
        rngCell.Offset(0, 2).Copy _
                Destination:=rngDest.Offset(intDestOffset, 0)
        rngCell.Offset(0, 3).Copy _
                Destination:=rngDest.Offset(intDestOffset, 1)
        'increment destination row offset
        intDestOffset = intDestOffset + 1
    End If
    If rngCell.Offset(0, 10).Text = strMrkr Then
        ' x in K so copy cells in columns C(3) and G(7) - offset value is one less
        rngCell.Offset(0, 2).Copy _
                Destination:=rngDest.Offset(intDestOffset, 0)
        rngCell.Offset(0, 6).Copy _
                Destination:=rngDest.Offset(intDestOffset, 2)
        'increment destination row offset
        intDestOffset = intDestOffset + 1
    End If
Next rngCell
'turn screen updating on again
Application.ScreenUpdating = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
'turn screen updating on again
Application.ScreenUpdating = True
End Sub


Hopefully the comments in the code will allow you to see what is happening, and make changes if required.

If you do decide to try this code, please test it on a copy of your data and always make a backup before running it, as macros cannot be undone using the Undo button.

Regards


Report •

Related Solutions

#4
March 10, 2010 at 11:00:21
Here's another way of getting it done.

I'm assuming you want BaseBid C & D copied to SL C & D if an "x" is found in J and BaseBid C & G copied to SL C & G if an "x" is found in K. Both of those assumptions are easily "fixed" if that is not what you want.

You'll notice that both Humar and I don't see a need for your Last function. I'd be interested in why you wer using it.

Option Explicit
Sub CopyVals()
Dim lstJ_Row, lstK_Row, valJ, valK, nxtC_Row As Integer
'Find last Rows in columns J & K
 lstJ_Row = Sheets("BaseBid").Range("J" & Rows.Count).End(xlUp).Row
 lstK_Row = Sheets("BaseBid").Range("K" & Rows.Count).End(xlUp).Row
'Loop through J, looking for x
  For valJ = 6 To lstJ_Row
   If Sheets("BaseBid").Cells(valJ, "J") = "x" Then
'If found...
 ''Find last Row in SL Column C
    nxtC_Row = Sheets("SL").Range("C" & Rows.Count).End(xlUp).Row + 1
 ''Copy BaseBid C & D to Sl C & D
     Sheets("BaseBid").Range("C" & valJ & ":D" & valJ).Copy _
       Destination:=Sheets("SL").Range("C" & nxtC_Row)
   End If
  Next
'Loop through J, looking for x
  For valK = 6 To lstK_Row
   If Sheets("BaseBid").Cells(valK, "K") = "x" Then
'If found...
 ''Find last Row in SL Column C
    nxtC_Row = Sheets("SL").Range("C" & Rows.Count).End(xlUp).Row + 1
 ''Copy BaseBid C & D to Sl C & g
     Sheets("BaseBid").Range("C" & valK).Copy _
       Destination:=Sheets("SL").Range("C" & nxtC_Row)
     Sheets("BaseBid").Range("D" & valK).Copy _
       Destination:=Sheets("SL").Range("G" & nxtC_Row)
   End If
  Next
End Sub


Report •

#5
March 10, 2010 at 11:05:09
Humar,
This works wonderfully. Thank you!

Report •

#6
March 10, 2010 at 11:50:38
Derby Dad,
I used the Last function because I wasn't sure how else to find the last row in the BaseBid sheet. Your way, and Humar's way, is much better. I appreciate the help from both of you, especially with all the comments which help me understand the code. It (obviously) has been a while since I've worked in VBA code. I knew there had to be a better and easier way, but didn't know how to go about it. Thank you!

Report •

#7
March 10, 2010 at 12:36:26
re: ...especially with all the comments which help me understand the code.

Don't feel so special...the comments aren't just for you. :-)

I add comments because I might write a macro and not look at the code for a year or more. (Which reminds me, it's time to pull the NCAA March Madness code out of storage.)

In addition, a member of this forum might post a question about some code that I wrote for them (or others) but that I've never really used.

If I didn't add comments I'd have to spend time trying to figure out why I did what I did before I could make modifications. So the comments are as much for me as they are for others.

You should get in the habit of adding copious comments so you too can "understand" your own code later on.


Report •

#8
March 10, 2010 at 12:42:14
Hi,

Glad to have been able to help.

Regards


Report •


Ask Question