PDA

View Full Version : reorganizing cell data on a diferent sheet



asenav
08-11-2016, 05:33 PM
My idea is to reorganize the data on sheet2, into sheet1, instead of doing it manually:

Lets say in Sheet2, I have data displayed in horizontal form, the rows have diferent lengts:


DATA-B
DATA-A1
DATA-A2
DATA-A3
DATA-A4
...
DATA-A31
DATA-A32


X
Y
A







S
A
D
S
S





D
D
D







S
S
D







D
S
D
F
D
...
S
S


A
D








S
E










And I need to relate the rows from the second columnt until their last to the name in the first row:


DATA-A
DATA-B


Y
X


A
X


A
S


D
S


S
S


S
S


D
D


D
D


..
..


E
S




My problem is that I have tried with loop, but not find the way to put this to work right:

Code:
Sub test()


Dim lastRow As Long
Dim pointerx As Integer
Dim pointery As Integer
Dim n As Integer
Dim cella As String
Dim cellb As String


'MsgBox lastRow
lastRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row




For pointery = 2 To lastRow
For pointerx = 2 To 32


cella = Trim(CStr(Sheet2.Cells(pointery, pointerx).Value))
ThisWorkbook.Sheets("Sheet1").Cells(pointerx, 1).Value = cella
If cella = "" Then
Exit For
End If
cellb = Trim(CStr(Sheet2.Cells(pointery, 1).Value))
ThisWorkbook.Sheets("Sheet1").Cells(pointery, 2).Value = cellb


Next pointerx


Next pointery






MsgBox ("finished")


End Sub



I am wondering if I will need a Do while, or another type of loop to do this task. I need help to troubleshoot this. I have attached a file.

Paul_Hossler
08-11-2016, 05:52 PM
The workbook and the requirements were a little confusing, but this takes the 2D array on sheet2 and makes it into a 2 col list with col A value o sheet2 in col B on sheet1, and each of the other values in col A




Option Explicit
Sub test3()
Dim r As Long, c As Long, o As Long
Dim v As Variant
Dim wsFrom As Worksheet, wsTo As Worksheet

Application.ScreenUpdating = True

Set wsFrom = Worksheets("Sheet2")
Set wsTo = Worksheets("Sheet1")

v = wsFrom.Cells(1, 1).CurrentRegion.Value
o = 1

For r = LBound(v, 1) + 1 To UBound(v, 1)
For c = LBound(v, 2) + 1 To UBound(v, 2)
If Len(v(r, c)) > 0 Then
wsTo.Cells(o, 1).Value = v(r, c)
wsTo.Cells(o, 2).Value = v(r, 1)
o = o + 1
End If
Next c
Next r
Application.ScreenUpdating = True
End Sub

asenav
08-12-2016, 01:58 PM
Thanks Paul Hossler!!!!!
This is what I needed!!! just only needed to start on A2, but yes this is what I need