Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel Macro Help, Copy Cells If Statement 2

Status
Not open for further replies.
mattloflin

mattloflin

MIS
Jan 13, 2008
167
US
Hello Everyone!

My task at hand is to copy cells to a different location based off of the information.

I have a template excel file where I copy the data to. The data is two columns and it varies in length.

it looks like:
col1 col2
bk/wh J1-32
wh/bl J2-12
bl/gr J3-27

There are 3 templates J1 Blue in cell B25 J2 Black in B15 and J3 Grey in B1. They all have cells to the right of them labeled 1 to 74.

I need a macro to say:

If col2 = j1 then copy col1 to the corresponding cell beside b25 (which is J1).

So bk/wh would be copied in the J1 template at the 32 number.

I have attached a file so download it and stuff. I can do all the formatting I just can't wrap my mind around the checking the number things.

The ranges can be set and all that however the col 1 will change in length and color and what cells correspond to what so it has to be an if statement or a for loop or something.

- Matt

"Never Give a Sword to a Man Who Can't Dance
 
Sort by date Sort by votes
Mattloflin,

Skip is one of the best on the forum. He likes to use questions to have the OP try and determine the answers to their own questions and also to get more detailed information.

To answer your question you can either
use conditional formatting. This will prevent you having to run code each time you change your template numbers. if you have the conditional format set so if the cell is blank then change the background

If you would rather use code. Then loop through the cells
I would recommend using a loop like for counter = 3 to 22 and then use cells(x,counter), where x = your rows to change color. Then have it if cells(x,counter)="" then cells(x,counter).interior.colorindex=36

Hope this helps

ck1999
 
Upvote 0 Downvote
i like all of skips info he is very degrading though seems like he's conceited and always correcting every wrong doing.

So sorry to both for the misinterpretation.

Hey CK1999 what if i did something like...

Code: 
        Case "J3":
            vnumber = Right(Cells(counter, vcol), 2)
            If Left(vnumber, 1) = "-" Then vnumber = Right(vnumber, 1)
            Select Case Val(vnumber)
               Case Is < 17: Cells(9, 23 - Val(vnumber)) = Cells(counter, vcol - 1)
                   Cells(counter, vcol - 1).Interior.ColorIndex = 2
               Case Is < 33: Cells(6, 23 - (Val(vnumber) - 16)) = Cells(counter, vcol - 1)
                   Cells(counter, vcol - 1).Interior.ColorIndex = 2
               Case Is < 53: Cells(4, 23 - (Val(vnumber) - 32)) = Cells(counter, vcol - 1)
                   Cells(counter, vcol - 1).Interior.ColorIndex = 2
               Case Is < 73: Cells(1, 23 - (Val(vnumber) - 52)) = Cells(counter, vcol - 1)
                   Cells(counter, vcol - 1).Interior.ColorIndex = 2
               Case Is = 73: Cells(6, 4) = Cells(counter, vcol - 1)
                  
            End Select

could that work? right now it doesn't but sounds possible? I have all the backgrounds that are applicable as yellow so if the text is copied then it also changes the background to white.

Ideas?

- Matt

"Never Give a Sword to a Man Who Can't Dance
 
Upvote 0 Downvote
It should, why do you say this

could that work? right now it doesn't but sounds possible?
Click to expand...


Also you forgot the =73 to add a color to that cell

also when you run the code again you will have to change all the cells back to the yellow before reupdating the templates

ck1999
 
Upvote 0 Downvote
Code: 
Sub ReArrange()
'
' ReArrange Macro
' Macro recorded 2/19/2008 by Matt Loflin
'

vlastrow = Range("x34").End(xlDown).Row
vcol = Range("x34").Column
For counter = 34 To vlastrow
    vJtype = Left(Cells(counter, vcol), 2)
    Select Case vJtype
        Case "J1":
            vnumber = Right(Cells(counter, vcol), 2)
            If Left(vnumber, 1) = "-" Then vnumber = Right(vnumber, 1)
            Select Case Val(vnumber)
               Case Is < 17: Cells(33, 23 - Val(vnumber)) = Cells(counter, vcol - 1)
                   Cells(33, 23 - Val(vnumber)).Interior.ColorIndex = 2
               Case Is < 33: Cells(30, 23 - (Val(vnumber) - 16)) = Cells(counter, vcol - 1)
                   Cells(30, 23 - (Val(vnumber) - 16)).Interior.ColorIndex = 2
               Case Is < 53: Cells(28, 23 - (Val(vnumber) - 32)) = Cells(counter, vcol - 1)
                   Cells(28, 23 - (Val(vnumber) - 32)).Interior.ColorIndex = 2
               Case Is < 73: Cells(25, 23 - (Val(vnumber) - 52)) = Cells(counter, vcol - 1)
                   Cells(25, 23 - (Val(vnumber) - 52)).Interior.ColorIndex = 2
               Case Is = 73: Cells(30, 4) = Cells(counter, vcol - 1)
                   Cells(30, 4).Interior.ColorIndex = 2
             End Select
             
        Case "J2":
            vnumber = Right(Cells(counter, vcol), 2)
            If Left(vnumber, 1) = "-" Then vnumber = Right(vnumber, 1)
            Select Case Val(vnumber)
               Case Is < 17: Cells(23, 23 - Val(vnumber)) = Cells(counter, vcol - 1)
                   Cells(23, 23 - Val(vnumber)).Interior.ColorIndex = 2
               Case Is < 33: Cells(20, 23 - (Val(vnumber) - 16)) = Cells(counter, vcol - 1)
                   Cells(20, 23 - (Val(vnumber) - 16)).Interior.ColorIndex = 2
               Case Is < 53: Cells(18, 23 - (Val(vnumber) - 32)) = Cells(counter, vcol - 1)
                   Cells(18, 23 - (Val(vnumber) - 32)).Interior.ColorIndex = 2
               Case Is < 73: Cells(15, 23 - (Val(vnumber) - 52)) = Cells(counter, vcol - 1)
                   Cells(15, 23 - (Val(vnumber) - 52)).Interior.ColorIndex = 2
               Case Is = 73: Cells(20, 4) = Cells(counter, vcol - 1)
                   Cells(20, 4).Interior.ColorIndex = 2
            End Select
            
        Case "J3":
            vnumber = Right(Cells(counter, vcol), 2)
            If Left(vnumber, 1) = "-" Then vnumber = Right(vnumber, 1)
            Select Case Val(vnumber)
               Case Is < 17: Cells(9, 23 - Val(vnumber)) = Cells(counter, vcol - 1)
                   Cells(9, 23 - Val(vnumber)).Interior.ColorIndex = 2
               Case Is < 33: Cells(6, 23 - (Val(vnumber) - 16)) = Cells(counter, vcol - 1)
                   Cells(6, 23 - (Val(vnumber) - 16)).Interior.ColorIndex = 2
               Case Is < 53: Cells(4, 23 - (Val(vnumber) - 32)) = Cells(counter, vcol - 1)
                   Cells(4, 23 - (Val(vnumber) - 32)).Interior.ColorIndex = 2
               Case Is < 73: Cells(1, 23 - (Val(vnumber) - 52)) = Cells(counter, vcol - 1)
                   Cells(1, 23 - (Val(vnumber) - 52)).Interior.ColorIndex = 2
               Case Is = 73: Cells(6, 4) = Cells(counter, vcol - 1)
                   Cells(6, 4).Interior.ColorIndex = 2
                  
            End Select
            
     End Select
Next counter '
End Sub

That's Money..

Thanks Guys!

- Matt

"Never Give a Sword to a Man Who Can't Dance
 
Upvote 0 Downvote



OK, Here's a totally spreadsheet solution.

Insert an EMPTY row in ROW 1

Add this formula in column W
[tt]
=IF(LEFT(B2,2)=0,W1,LEFT(B2,2))
[/tt]
to propogate the J number thru all rows of data

name the Color range, W35:W153 CLR
PARSE the Jnumber from the data after the dash
name the Jnumber range CON
name the Number range VAL

Formula ABOVE the numbers
[tt]
=INDEX(OFFSET($W$35,MATCH($W2,CON,0),0,COUNTIF(CON,$W2),1), MATCH(C3,OFFSET($W$35,MATCH($W2,CON,0),2,COUNTIF(CON,$W2),1),0),1)
[/tt]
Formula BELOWthe numbers
[tt]
=INDEX(OFFSET($W$35,MATCH($W5,CON,0),0,COUNTIF(CON,$W5),1), MATCH(C4,OFFSET($W$35,MATCH($W5,CON,0),2,COUNTIF(CON,$W5),1),0),1)
[/tt]
...the ONLY difference being the bold Match lookup ref.

Select all the cells containing the INDEX formulas and Conditional Format
[tt]
=ISNA(C2)
[/tt]
and set BOTH Font and Pattern to the same SHADE.

Now My START looks just like FINISH, just 1 row difference.

My work for the last 35 min.


Skip,

[glasses]Did you hear what happened when the OO programmer lost his library?...
He's now living in OBJECT poverty![tongue]
 
Upvote 0 Downvote
SKIP woo hoo can you explain this a little more to me?

I don't understand what it is doing. It seems as though it will work.

I don't understand the thinking behind it but that's only because i don't get it.

I think that's too much work to be real.

I copy those two columns and click run and it does it all coloring and everything.

Is this way easier or do I have to do more than copy and paste?

- Matt

"Never Give a Sword to a Man Who Can't Dance
 
Upvote 0 Downvote



and here's some code that I whipped up over the past hour and a half. No changes in the Start format.
Code: 
Sub test()
    Dim ma As Range, r As Range, i As Integer, j As Integer, jNum As String
    Dim iLastCol As Integer, Found
    
    With [B1].CurrentRegion
        iLastCol = .Columns.Count
    End With
    Set ma = [B1].MergeArea
    Do While ma.Cells(1, 1).Address <> ma.Address
        jNum = Left(ma.Cells(1, 1).Value, 2)
        For j = -1 To 1 Step 2
            For i = 2 To 3
                For Each r In Range(ma.Cells(5 + i * j, 2), ma.Cells(5 + i * j, iLastCol))
                    If IsEmpty(r) Then
                    Else
                        Found = Application.Match(jNum & "-" & r.Value, [CON], 0)
                        If IsError(Found) Then
                            Select Case i
                                Case 3
                                    r.Offset(j).Interior.ColorIndex = 36
                                Case 2
                                    r.Offset(-j).Interior.ColorIndex = 36
                            End Select
                        Else
                            Select Case i
                                Case 3
                                    r.Offset(j).Interior.ColorIndex = xlNone
                                    r.Offset(j).Value = Application.Index([CLR], Found, 1)
                                Case 2
                                    r.Offset(j).Interior.ColorIndex = xlNone
                                    r.Offset(-j).Value = Application.Index([CLR], Found, 1)
                            End Select
                        End If
                    End If
                Next
            Next
        Next
        Set ma = ma.End(xlDown).MergeArea
    Loop
End Sub


Skip,

[glasses]Did you hear what happened when the OO programmer lost his library?...
He's now living in OBJECT poverty![tongue]
 
Upvote 0 Downvote



what part do you want an explanation for?

Skip,

[glasses]Did you hear what happened when the OO programmer lost his library?...
He's now living in OBJECT poverty![tongue]
 
Upvote 0 Downvote
So does that code do the same thing as the thing ck1999 does?

Is it just faster or something?

- Matt

"Never Give a Sword to a Man Who Can't Dance
 
Upvote 0 Downvote
that code just colors the back ground yellow. I have already solved that by coloring the background yellow on the template and when they paste the copied cells it makes the back ground white.

Skip is that second code just for the background colors? If you could give a description to what it is doing that'd be awesome.

Also congrats on the award/ achievement in this site. You are a very busy guy it seems like

- Matt

"Never Give a Sword to a Man Who Can't Dance
 
Upvote 0 Downvote




I strive to generate tight code. I am not always as sucessful as I like to be. I am constantly learning from others, especially here at Tek-Tips.

The only work done on the spreadsheet is naming the two lookup ranges CLR & CON...
Code: 
Sub test()
    Dim ma As Range, r As Range, i As Integer, j As Integer, jNum As String
    Dim iLastCol As Integer, Found
'calculate the last column OFFSET from column B
    iLastCol = [B1].CurrentRegion.Columns.Count
'the loop is based on the Merged Areas
' set ma = the Merged Area RANGE
    Set ma = [B1].MergeArea
'loop while the address of the FIRST cell in the Merged Area is not the address of the Merged Area
    Do While ma.Cells(1, 1).Address <> ma.Address
        jNum = Left(ma.Cells(1, 1).Value, 2)
        'these next two loops are based on the symetry around the 5th row in the Merged Area
        'rows 2 & 3 ABOVE and BELOW the 5th row have numbers that will be concatenated with the jNum
        For j = -1 To 1 Step 2
            For i = 2 To 3
            'this loop is the range of numbers
                For Each r In Range(ma.Cells(5 + i * j, 2), ma.Cells(5 + i * j, iLastCol))
                'if the range is not empty then do stuff
                    If Not IsEmpty(r) Then
                    'lookup the concatenated value in the Named Range CON
                        Found = Application.Match(jNum & "-" & r.Value, [CON], 0)
                        If IsError(Found) Then
                        'if no match then shade the cell
                            Select Case i
                                Case 3
                                    r.Offset(j).Interior.ColorIndex = 36
                                Case 2
                                    r.Offset(-j).Interior.ColorIndex = 36
                            End Select
                        Else
                        'otherwise write the CLR value uning the INDEX function
                        'remove any interior shade
                            Select Case i
                                Case 3
                                    r.Offset(j).Interior.ColorIndex = xlNone
                                    r.Offset(j).Value = Application.Index([CLR], Found, 1)
                                Case 2
                                    r.Offset(j).Interior.ColorIndex = xlNone
                                    r.Offset(-j).Value = Application.Index([CLR], Found, 1)
                            End Select
                        End If
                    End If
                Next
            Next
        Next
        'set the next Merged Area
        Set ma = ma.End(xlDown).MergeArea
    Loop
End Sub
There is nor than one way to skin a cat. ;-)

Skip,

[glasses]Did you hear what happened when the OO programmer lost his library?...
He's now living in OBJECT poverty![tongue]
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Question
If obsolete - deactivate all but one macro
Replies
6
Views
425
mintjulep
M
Andrzejek
  • Locked
  • Question
Copy data between SQL and Oracle 1
Replies
8
Views
936
remeng
remeng
remeng
  • Locked
  • Question
CTRL + BREAK from second macro button
Replies
5
Views
733
strongm
strongm
remeng
  • Locked
  • Helpful tip
Microsoft Office 365 Word Macro Causing a Project is unviewable error
Replies
1
Views
1K
dhookom
dhookom
remeng
  • Locked
  • Question
Multiple Users in a Macro enabled Excel Doc
Replies
0
Views
317
remeng
remeng

Part and Inventory Search

Sponsor

Back
Top