Can data be moved from a string in a cell based on what color the cell is?

[donnabee]

Hi!
There are several pieces of data I'm trying to automate or at least make easier to obtain rather than cut/paste.

On the green line, I would need what comes after Ch but not after the full stop EG: 81A Ch 047214.05805.jpg and it would to in column G for Start Chainage on that green line.
The green line Y and X coordinates to go where they belong in columns I and J with either a button or something simple?

On the red line, I would need the same string extracted for End Chainage (Column H) on the green line and also the X and Y coordinates on the End Y and End X on the green line.

I have the top line frozen so even just being able to bang a button in the row headers G H I J K L to get the data to move to the cells would be awesome.

Is what I'm hoping to achieve possible or will i have to stick to cut and paste? I'm hoping to stop the cut paste because getting the red lines pasted is extra annoying because I have to do that as plain text so the colors don't transfer onto the green line.

 

[mikenelena]

Hi donnabee,

Maybe this will get you started. I re-created a very rudimentary version of your spreadsheet and tested the code. It seems to do what you want, though you'll have to fine-tune the color index references. It should get you started at least. Good luck!

Sub MoveValues()

    Dim i As Integer
    Dim lastRow As Integer
    Dim lastGreenRow As Integer
    
    lastRow = ActiveSheet.UsedRange.Rows.Count
    lastGreenRow = 0 ' Initialize last green row to 0
    
    For i = 1 To lastRow
        
        If Range("B" & i).Interior.ColorIndex = 4 Then ' Green color code is 4
            
            Range("G" & i) = Left(Range("B" & i), InStr(1, Range("B" & i), ".") - 1) ' Move value to G column
            Range("I" & i) = Range("E" & i) ' Move E value to I column
            Range("J" & i) = Range("F" & i) ' Move F value to J column
            
            lastGreenRow = i ' Update last green row to current row
            
        ElseIf Range("B" & i).Interior.ColorIndex = 3 And lastGreenRow > 0 Then ' Red color code is 3
            
            Range("H" & lastGreenRow) = Left(Range("B" & i), InStr(1, Range("B" & i), ".") - 1) ' Move value to H column of last green row
            Range("K" & lastGreenRow) = Range("E" & i) ' Move E value to K column of last green row
            Range("L" & lastGreenRow) = Range("F" & i) ' Move F value to L column of last green row
            
        Else ' Ignore rows that are not colored green or red
            ' Do nothing
        End If
        
    Next i

End Sub

 

[donnabee]

Oh my GOSH thank you so much, I'm going to try it out now.

If I could upload my actual one sheet Macros book I would, it has all my current formulas and everything in it.

 

[mikenelena]

Donna, please mark your issue as solved, so it can be removed from the Unsolved list. Thanks!