CODEWITHSUNDEEP
excelvbastring
Christina Vedel-Smith
Christina Vedel-Smith

Reputation: 5

interior cell color seems to obscure text

I have a problem with my script not being able to "see" the text in a cell if it is colored.

I have two rows with all most the same data, but only one of the two is correct, and that cell has interior colorindex = 6

What I would like is to copy the text in the cells which are yellow and paste it into column D

I thought that it would be simple... I was wrong, because it seems like my script cannot see the text if the cell is colored.

My problem is centered around the strOldFolderName and strNewFolderName.

I have tried to get the text from column 2 and 3 into these strings, but if the cell is colored, the string is empty, even though the value on the other side of the = shows the correct text, if I set a stop in the sub and run it.

If the cell is not colored there is no problem with the string, it contains the correct text.

But it seems illogical to just switch the two, when I do not know what causes the inability to read the text in the cell.

I hope this make sense. Thanks for any advice :)

Here are my script:

 Sub PhotoDocCopyToLupus()
 
 Dim intOldFolderNameColumn As Integer 
 Dim intNewFolderNameColumn As Integer 
 Dim intCorrectFolderNameColumn As Integer 
 Dim intRowStart As Integer 
 Dim intRowEnd As Integer 
 Dim i As Integer
 
 Dim strOldFolderName As String 
 Dim strNewFolderName As String 
 Dim strCorrectFolderName As String
 
 intOldFolderNameColumn = 2 
 intNewFolderNameColumn = 3
 intCorrectFolderNameColumn = 4 
 intRowStart = 2 
 intRowEnd = 15
 
 Worksheets("Compare").Activate 
 Cells(1, 4) = "CorrectFolderName"
 
 For i = intRowStart To intRowEnd
 
     strOldFolderName = Trim(Cells(i, intOldFolderNameColumn))
     strNewFolderName = Trim(Cells(i, intNewFolderNameColumn))
 
         If Cells(i, intOldFolderNameColumn).Interior.ColorIndex = 6 Then
             strOldFolderName = Trim(Cells(i, intOldFolderNameColumn))
             strOldFolderName = strCorrectFolderName
         ElseIf Cells(i, intNewFolderNameColumn).Interior.ColorIndex = 6 Then
             strNewFolderName = Trim(Cells(i, intNewFolderNameColumn))
             strNewFolderName = strCorrectFolderName
         Else
             strCorrectFolderName = ""
             Cells(i, intCorrectFolderNameColumn).Interior.ColorIndex = 35
         End If
     
     Cells(i, intCorrectFolderNameColumn) = strCorrectFolderName
 
 Next i
 
 End Sub

Upvotes: 0

Views: 43

Answers (1)

Tim Williams
Tim Williams

Reputation: 166366

Should do what you want:

Sub PhotoDocCopyToLupus()
 
    'use constants for fixed values...
    Const COL_OLD_FLDR As Long = 2
    Const COL_NEW_FLDR As Long = 3
    Const COL_CORR_FLDR As Long = 4
    Const ROW_START As Long = 2
    Const ROW_END As Long = 15
    
    Dim i As Long, corrName As String
 
    With Worksheets("Compare")
        .Cells(1, COL_CORR_FLDR) = "CorrectFolderName"
    
        For i = ROW_START To ROW_END
            If .Cells(i, COL_OLD_FLDR).Interior.ColorIndex = 6 Then
                corrName = Trim(.Cells(i, COL_OLD_FLDR))
            ElseIf .Cells(i, COL_NEW_FLDR).Interior.ColorIndex = 6 Then
                corrName = Trim(.Cells(i, COL_NEW_FLDR))
            Else
                corrName = ""
                .Cells(i, COL_CORR_FLDR).Interior.ColorIndex = 35
            End If
            .Cells(i, COL_CORR_FLDR) = corrName
        Next i
    End With
 
 End Sub

Upvotes: 1

Related Questions