Solved: Restore Cell colores from saved information

[frank_m]

I wrote the macro below to record information in Column H, regarding the colors used in the Column A thru G cells of the selected row.
ie: (3,1)8 (3,2)8 (3,3)8 (3,4)45 (3,5)6 (3,6)6 (3,7)3

I need code to restore the colors using that information.

A sample workbook is attached.

[vba]
Private Sub CommandButton1_Click()
'Column H used to save the color index & cell location for each cell in active row
Dim TheRow As Range
Dim cll As Range, CellColorsInRow As String

Set TheRow = ActiveCell.EntireRow.Cells(1).Resize(, 7)

ActiveCell.EntireRow.Cells(8).ClearContents

If ActiveCell.Row > 1 And Selection.Rows.Count = 1 Then

For Each cll In TheRow
If cll.Interior.ColorIndex > 0 Then
CellColorsInRow = CellColorsInRow & _
" (" & cll.Row & "," & cll.Column & ")" & cll.Interior.ColorIndex
End If
Next cll
End If

ActiveCell.EntireRow.Cells(8).Value = CellColorsInRow
TheRow.Interior.ColorIndex = xlNone
End Sub
[/vba]

[Bob Phillips]

[vba]

Private Sub CommandButton1_Click()
Dim TheRow As Range
Dim cll As Range, CellColours As String

With ActiveCell

If .Row <> 2 And .Row <> 3 And .Row <> 4 Then
MsgBox "select a row that has colors", vbOKOnly, "Colour Manager"
Exit Sub
End If

If .Row > 1 And Selection.Rows.Count = 1 Then

Set TheRow = .EntireRow.Cells(1).Resize(, 7)

.EntireRow.Cells(8).ClearContents

For Each cll In TheRow

If cll.Interior.ColorIndex > 0 Then

CellColours = CellColours & cll.Row & "," & cll.Column & "," & cll.Interior.ColorIndex & ","
End If
Next cll

.EntireRow.Cells(1, 8).Value = Left$(CellColours, Len(CellColours) - 1)
TheRow.Interior.ColorIndex = xlNone
End If
End With
End Sub

Private Sub CommandButton2_Click()
Dim TheRow As Range
Dim CellColors As Variant
Dim i As Long

With ActiveCell

If .EntireRow.Cells(1, 8).Value = "" Then

MsgBox "Select a row that has been cleared", vbOKOnly, "Colour Manager"
Exit Sub
End If

If .Row > 1 And Selection.Rows.Count = 1 Then

Set TheRow = .EntireRow.Cells(1).Resize(, 7)

CellColors = Split(.EntireRow.Cells(1, 8).Value, ",")
For i = LBound(CellColors) To UBound(CellColors) Step 3

Cells(Val(CellColors(i)), Val(CellColors(i + 1))).Interior.ColorIndex = Val(CellColors(i + 2))
Next i
End If

.EntireRow.Cells(1, 8).ClearContents
End With
End Sub
[/vba]

[frank_m]

Works great. - Thank you very much Bob.

[Bob Phillips]

Actually Frank, I like this small change better

[vba]


Private Sub CommandButton1_Click()
Dim TheRow As Range
Dim cll As Range, CellColours As String

With ActiveCell

If .Row <> 2 And .Row <> 3 And .Row <> 4 Then
MsgBox "select a row that has colors", vbOKOnly, "Colour Manager"
Exit Sub
End If

If .Row > 1 And Selection.Rows.Count = 1 Then

Set TheRow = .EntireRow.Cells(1).Resize(, 7)

.EntireRow.Cells(8).ClearContents

For Each cll In TheRow

If cll.Interior.ColorIndex > 0 Then

CellColours = CellColours & cll.Address & "," & cll.Interior.ColorIndex & ","
End If
Next cll

.EntireRow.Cells(1, 8).Value = Left$(CellColours, Len(CellColours) - 1)
TheRow.Interior.ColorIndex = xlNone
End If
End With
End Sub

Private Sub CommandButton2_Click()
Dim TheRow As Range
Dim CellColors As Variant
Dim i As Long

With ActiveCell

If .EntireRow.Cells(1, 8).Value = "" Then

MsgBox "Select a row that has been cleared", vbOKOnly, "Colour Manager"
Exit Sub
End If

If .Row > 1 And Selection.Rows.Count = 1 Then

Set TheRow = .EntireRow.Cells(1).Resize(, 7)

CellColors = Split(.EntireRow.Cells(1, 8).Value, ",")
For i = LBound(CellColors) To UBound(CellColors) Step 2

Range(CellColors(i)).Interior.ColorIndex = Val(CellColors(i + 1))
Next i
End If

.EntireRow.Cells(1, 8).ClearContents
End With
End Sub[/vba]

[frank_m]

Yeah, that's nice. - Both efficient and makes the recorded information much easier to read.

Thanks for taking the extra time.

[Bob Phillips]

Yeah, that's nice. - Both efficient and makes the recorded information much easier to read.

Exactly