Thread: simple question
View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
JMB JMB is offline
external usenet poster
 
Posts: 2,062
Default simple question

Modified to ensure there is at least one 1 or 0 in the row before redimming
the array, otherwise will generate an error.

Sub test()
Dim lRow As Long
Dim lCol As Long
Dim lCount As Long
Dim arrData()
Dim objDest As Worksheet
Dim rngData As Range

Set objDest = Worksheets("Sheet2")
Set rngData = Selection
objDest.Cells.Clear

With rngData
For lRow = 2 To .Rows.Count
If Application.CountIf(.Rows(lRow), 1) + _
Application.CountIf(.Rows(lRow), 0) 0 Then
ReDim arrData(1 To Application.CountIf(.Rows(lRow), 1) + _
Application.CountIf(.Rows(lRow), 0))
lCount = LBound(arrData)
For lCol = 1 To .Columns.Count
If .Cells(lRow, lCol).Value = 0 And _
Not IsEmpty(.Cells(lRow, lCol)) Then
arrData(UBound(arrData)) = .Cells(1, lCol).Value
ElseIf .Cells(lRow, lCol).Value = 1 Then
arrData(lCount) = .Cells(1, lCol).Value
lCount = lCount + 1
End If
Next lCol
'Do something with arrData
'before going to the next row
With objDest
.Range(.Cells(lRow - 1, 1), _
.Cells(lRow - 1, UBound(arrData) - _
LBound(arrData) + 1)).Value = arrData
End With
End If
Next lRow
End With
End Sub


"JMB" wrote:

Maybe you could use a macro similar to this. You can select your table
(including the header row, but excluding any column labels - which I'm
assuming is column A) then run it. It goes through the data one row at a
time and creates a one dimensional array as you described. You'll need to
include code to do something with the array before the code loops to the next
row (as the data in the array will get destroyed). I just put the data in
Sheet2 (change or modify as needed). Be sure to back up your data before
testing.


Sub test()
Dim lRow As Long
Dim lCol As Long
Dim lCount As Long
Dim arrData()
Dim objDest As Worksheet
Dim rngData As Range

Set objDest = Worksheets("Sheet2")
Set rngData = Selection
objDest.Cells.Clear

With rngData
For lRow = 2 To .Rows.Count
ReDim arrData(1 To Application.CountIf(.Rows(lRow), 1) + _
Application.CountIf(.Rows(lRow), 0))
lCount = LBound(arrData)
For lCol = 1 To .Columns.Count
If .Cells(lRow, lCol).Value = 0 And _
Not IsEmpty(.Cells(lRow, lCol)) Then
arrData(UBound(arrData)) = .Cells(1, lCol).Value
ElseIf .Cells(lRow, lCol).Value = 1 Then
arrData(lCount) = .Cells(1, lCol).Value
lCount = lCount + 1
End If
Next lCol
'Do something with arrData
'before going to the next row
With objDest
.Range(.Cells(lRow - 1, 1), _
.Cells(lRow - 1, UBound(arrData) - _
LBound(arrData) + 1)).Value = arrData
End With
Next lRow
End With
End Sub

"Bob Bedford" wrote:

Hello,

I've a table wich has 45 columns and 104 lines.
the column header are simply numbers from 1 (on B1) to 45 (on AT1).
now, on each line (from 2 to 105) I've 6 times the value "1" and once the
value "0".
The resulting array I'd like is the values where there is a 1 and the last
value where there is the 0.
I mean if the first value line has a 1 in the column K,L,M,N,O and P then
the 0 in the column B, I the resulting array must be 10,11,12,13,14,15 and
last the value 1 (as the 0 is in the column B and must be the last value).
(one value per cell, as I must export this table further).

How to do so ?

Thanks for helping.

Bob