Copying Values and Color Index in an Array

2019-07-26 08:03发布

I have a macro that allows me to open multiple files based on their names and copy sheets based on a criteria (if there's a value in column "X" then copy the row but only some colums "F,G,P,Q,W,X,Y) to another unique workbook. the problem is in column F i have a color and i want to retrieve the color index but the macro leaves it blank

 [1] Get data from A1:Z{n}

  n = ws.Range("A" & Rows.Count).End(xlUp).Row   ' find last row number n
  v = ws.Range("A10:Y" & n).Value2 ' get data cols A:Y and omit header row

 [2] build array containing found rows

  a = buildAr2(v, 24) ' search in column X = 24

' [3a] Row Filter based on criteria

  v = Application.Transpose(Application.Index(v, _
  a, _
Application.Evaluate("row(1:" & 26 & ")"))) ' all columns from A to Z

[3b] Column Filter F,G,P,Q,W,X,Y

  v = Application.Transpose(Application.Transpose(Application.Index(v, _
      Application.Evaluate("row(1:" & UBound(a) - LBound(a) + 1 & ")"), _
      Array(6, 7, 16, 17, 23, 24, 25))))          ' only cols F,G,P,Q,W,X,Y

Function buildAr2(v, ByVal vColumn&, Optional criteria) As Variant
' Purpose: Helper function to check in Column X
' Note:    called by main function MultiCriteria in section [2]
Dim found&, found2&, i&, j&, n&, ar: ReDim ar(0 To UBound(v) - 1)
howMany = 0      ' reset boolean value to default
  For i = LBound(v) To UBound(v)
    If Len(Trim(v(i, vColumn))) > 0 Then
       ar(n) = i
       n = n + 1
    End If
  Next i
  If n < 2 Then
     howMany = n: n = 2
  Else
     howMany = n
  End If
  ReDim Preserve ar(0 To n - 1)
  buildAr2 = ar
End Function

3条回答
【Aperson】
2楼-- · 2019-07-26 08:27

In addition to the comments above by @Pᴇʜ, the fact that you are mainly dealing with v, a variant array of strings, is going to be a limiting factor. You are going to have to deal with a Range if you want the .Interior.ColorIndex property of the cell (Range).

Also, if you want to be precise about the color, use color instead of ColorIndex.
ColorIndex will return the closest indexed color.

查看更多
Evening l夕情丶
3楼-- · 2019-07-26 08:37

I have no idea where the problem is, but you asked:

the problem is in column F i have a color and i want to retrieve the color index but the macro leaves it blank

Here's how you retrieve the colorindex from Cell A1:

col = Range("A1").Interior.ColorIndex

I would suggest you try retrieving it and if you run into a problem: open a question with your example, as Pᴇʜ suggested.

查看更多
贼婆χ
4楼-- · 2019-07-26 08:38

How to copy filtered array values together with color format (column F)

  • You got the solution to filter a data field Array v by row AND column using the Application.Index property and write these data to a target sheet - c.f. Multi criteria selection with VBA
  • Your issue was to find a way to write not only data, but also the source color formatting of column F to the target cells, as an array per se contains values and no color info.

Write the filtered information to a defined STARTROW (e.g. 10), then you can use the item numbers of array a adding a headline offset headerIncrement) to reconstruct the source row numbers by a simple loop in order to get/write the color formats, too:

Code addition

' [4a] Copy results array to target sheet, e.g. start row at A10
  Const STARTROW& = 10
  ws2.Cells(STARTROW, 1).Offset(0, 0).Resize(UBound(v), UBound(v, 2)) = v
' **************************************************************************
' [4b] Copy color formats using available item number information in array a
' **************************************************************************
  Dim sourceColumn&: sourceColumn = 6   ' <<~~ source column F = 6
  Dim targetColumn&: targetColumn = 1   ' <<~~ becomes first target column
  Dim headerIncrement&: headerIncrement = STARTROW - 1
  For i = 0 To UBound(a)
    ws2.Cells(i + headerIncrement, targetColumn).Offset(1, 26).Interior.Color = _
    ws.Cells(a(i) + headerIncrement, sourceColumn).Interior.Color
  Next i

Side Note Don't forget to set Option Explicit to force declaration of variables and to declare the variable howMany (used in both procedures) in the declaration head of your code module.

查看更多
登录 后发表回答