PDA

View Full Version : Solved: Restore Cell colores from saved information



frank_m
02-06-2012, 06:20 AM
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.


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

xld
02-06-2012, 07:08 AM
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

frank_m
02-06-2012, 07:25 AM
Works great. - Thank you very much Bob. :friends:

xld
02-06-2012, 07:44 AM
Actually Frank, I like this small change better




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

frank_m
02-06-2012, 10:12 AM
Yeah, that's nice. - Both efficient :bow: and makes the recorded information much easier to read.

Thanks for taking the extra time.

xld
02-06-2012, 10:49 AM
Yeah, that's nice. - Both efficient :bow: and makes the recorded information much easier to read.

Exactly :)